Ceci est une page optimisée pour les mobiles. Cliquez sur ce texte pour afficher la vraie page.

besoin d'aide

Créer une discussion
  • Initiateur de la discussion Initiateur de la discussion fenec
  • Date de début Date de début

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

S'inscrire

fenec

XLDnaute Impliqué
bonjour le forum
j'utilise actuellement une macro pour ma sauvegarde qui fonctionne tres bien mais mon souci est que la mise en page n'est pas respecter
j'entends par la que la largeur des colonnes et la hauteur des lignes ne sont pas mes memes
je ne sais d'ailleurs pas si cela est possible
voila la macro que j'utilise


Private Sub CommandButton1_Click()
'évite les basculements d'écrans
Application.ScreenUpdating = False
' bouton valider
nomfichier = ActiveWorkbook.Name
'ouverture nouveau classeur - 1 feuille - ne fonctionne pas sous XL97
défaut = Application.SheetsInNewWorkbook
Application.SheetsInNewWorkbook = 1
Workbooks.Add
Application.SheetsInNewWorkbook = défaut
nomfichier1 = ActiveWorkbook.Name
'copie la feuille
Windows(nomfichier).Activate
Range("Zone_d_impression").Copy
'colle dans nouveau fichier
Windows(nomfichier1).Activate
ActiveSheet.Range("B6").Select
ActiveSheet.Paste
'protège les cellules
ActiveSheet.Range(Selection.Address).Locked = True
ActiveSheet.Protect
ActiveSheet.Range("B6").Select
'enregistre sous le répertoire Factures, selon numéro de facture
ChDir (ThisWorkbook.Path & "\Users\Philippe\Documents\Sauvegardes Devis")
'choix avec nom par défaut, possibilité de changer le nom ou annuler
fermer = Application.GetSaveAsFilename(ActiveSheet.Range("E17").Value, "Fichiers Excel,*.xls")
'si annulation
If fermer = False Then
Windows(nomfichier1).Activate
ActiveWorkbook.Close Savechanges:=False
Exit Sub
End If
'sinon
ActiveWorkbook.SaveAs Filename:=fermer
ActiveWorkbook.Close
'retour sur modèle
'raz champ Aremplir

'incrément N° commande
num = Format(Val(Right(Range("R18"), 3)) + 1, "000")
ActiveSheet.Unprotect
Range("R18") = Left(Range("R18"), 8) & num
ActiveSheet.Protect
'sauve modèle avec numéro incrémenté
'ActiveWorkbook.Save
'réautorise les basculements d'écran
Application.ScreenUpdating = True

End Sub


merci d'avance
 
Trier par date Trier par votes
Re : besoin d'aide

Bonjour

Il faut rajouter derrière le : "ActiveSheet.Paste" qui lui colle les onnées
une instruction :
"ActiveSheet.PasteSpecial" avec comme argument
xlPasteColumnWidths pour coller la largeur originale des colonnes
 
Vote positif 0 Vote négatif
Re : besoin d'aide

Bonjour,

Pas top ces Activate et autres Select, ils sont inutiles ici (presque toujours le cas en VBA).

Donc remplacer le bloc :

Code: 
'copie la feuille
Windows(nomfichier).Activate
Range("Zone_d_impression").Copy
'colle dans nouveau fichier
Windows(nomfichier1).Activate
ActiveSheet.Range("B6").Select
ActiveSheet.Paste
'protège les cellules
ActiveSheet.Range(Selection.Address).Locked = True
par :

Code: 
'copie la feuille
Me.Cells.Copy ActiveSheet.[A1]
ActiveSheet.Cells.Clear
With Me.Range("Zone_d_impression")
  .Copy ActiveSheet.[B6]
  'verrouille les cellules
  ActiveSheet.[B6].Resize(.Rows.Count, .Columns.Count).Locked = True
End With
Ainsi les dimensions des lignes et colonnes seront copiées.

A+
 
Vote positif 0 Vote négatif
Re : besoin d'aide

Bonjour le fil, bonjour le forum,

Comme je m'y suis penché dessus, je te propose cet autre solution en récupérant hauteurs de lignes et largeurs de colonnes dans deux tableaux dynamiques tbl et tbc :
Code: 
Private Sub CommandButton1_Click()
 
'*************************
'déclaration des variables
Dim nomfichier As String
Dim nomfichier1 As String
Dim li As Range
Dim tbl() As Single
Dim x As Integer
Dim col As Range
Dim tbc() As Single
'*************************
 
'évite les basculements d'écrans
Application.ScreenUpdating = False
' bouton valider
nomfichier = ActiveWorkbook.Name
'ouverture nouveau classeur - 1 feuille - ne fonctionne pas sous XL97
défaut = Application.SheetsInNewWorkbook
Application.SheetsInNewWorkbook = 1
Workbooks.Add
Application.SheetsInNewWorkbook = défaut
nomfichier1 = ActiveWorkbook.Name
'copie la feuille
Windows(nomfichier).Activate
 
'***********************
'tableau des lignes tbl
x = 0
ReDim tbl(Range("Zone_d_impression").Rows.Count - 1)
For Each li In Range("Zone_d_impression").Rows
    tbl(x) = li.RowHeight
    x = x + 1
Next li
'***********************
 
'************************
'tableau des colonnes tbc
x = 0
ReDim tbc(Range("Zone_d_impression").Columns.Count - 1)
For Each col In Range("Zone_d_impression").Columns
    tbc(x) = col.ColumnWidth
    x = x + 1
Next col
'************************
 
Range("Zone_d_impression").Copy
'colle dans nouveau fichier
Windows(nomfichier1).Activate
ActiveSheet.Range("B6").Select
ActiveSheet.Paste
 
'*******************************
'récupère les hauteurs de lignes
x = 0
For Each li In Selection.Rows
    li.RowHeight = tbl(x)
    x = x + 1
Next li
'*******************************
 
'*********************************
'récupère les hauteurs de colonnes
x = 0
For Each col In Selection.Columns
   col.ColumnWidth = tbc(x)
   x = x + 1
Next col
'*********************************
 
'protège les cellules
ActiveSheet.Range(Selection.Address).Locked = True
ActiveSheet.Protect
ActiveSheet.Range("B6").Select
'enregistre sous le répertoire Factures, selon numéro de facture
ChDir (ThisWorkbook.Path & "\Users\Philippe\Documents\Sauvegardes Devis")
'choix avec nom par défaut, possibilité de changer le nom ou annuler
fermer = Application.GetSaveAsFilename(ActiveSheet.Range("E 17").Value, "Fichiers Excel,*.xls")
'si annulation
If fermer = False Then
    Windows(nomfichier1).Activate
    ActiveWorkbook.Close Savechanges:=False
    Exit Sub
End If
'sinon
ActiveWorkbook.SaveAs Filename:=fermer
ActiveWorkbook.Close
'retour sur modèle
'raz champ Aremplir
'incrément N° commande
num = Format(Val(Right(Range("R18"), 3)) + 1, "000")
ActiveSheet.Unprotect
Range("R18") = Left(Range("R18"), 8) & num
ActiveSheet.Protect
'sauve modèle avec numéro incrémenté
'ActiveWorkbook.Save
'réautorise les basculements d'écran
Application.ScreenUpdating = True
End Sub
 
Vote positif 0 Vote négatif
Identifiez-vous ou inscrivez-vous pour participer.
Rejoins nos membres "Supporter XLD" et booste ton expérience Excel !
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

S
  • Résolu(e)
Microsoft 365 Mailing mise en forme HTML : revenir à la ligne automatique si trop de texte saisie
2
Réponses
17
Affichages
546
spike29
S
S
  • Résolu(e)
XL 2016 Besoin d'aide pour un code d'extraction
Réponses
14
Affichages
895
Phil69970
F
  • Question Question
Microsoft 365 Changement de fonctionnement d'une macro suite au passage à windows 10
Réponses
1
Affichages
528
francha62
F
U
  • Question Question
Autres incorporer une macro dans une autre macro
Réponses
5
Affichages
475
Phil69970
F
  • Résolu(e)
XL 2021 fermeture du classeur après apple d'un userform d'un autre classeur ouvert
Réponses
2
Affichages
361
farid
F
L
  • Résolu(e)
Microsoft 365 Pb de valeur de variable entre Sub
Réponses
5
Affichages
603
loreak
L
XLS : Evènements souris 'click' sur la grille & astuces
Réponses
3
Affichages
163
Lu76Fer
C
  • Question Question
XL 2019 1004 sur un ActiveSheet.Paste
Réponses
5
Affichages
516
Cheyenne_2021
C
Q
  • Résolu(e)
Microsoft 365 Exécutions directes différentes vs "pas à pas"
Réponses
2
Affichages
535
Quentin2106
Q
C
  • Résolu(e)
XL 2016 Remplir automatiquement un tableau d'après des conditions et des valeurs
Réponses
11
Affichages
2 K
ERIC S
S
  • Résolu(e)
Autres ActiveWorkbook.Worksheets("vierge").AutoFilter.Sort.SortFields.Clear
2
Réponses
23
Affichages
2 K
AtTheOne
  • Résolu(e)
XL 2019 alléger code VBA (supprimer activate / select / copy / activate / select / paste)
Réponses
4
Affichages
2 K
Eric 888
A
  • Question Question
XL 2019 Besoin d'aide pour copier les lignes d'un classeur et les coller dans un autre classeur par le bié d'un bouton (VBA)
Réponses
7
Affichages
1 K
aka100k
A
K
  • Question Question
Microsoft 365 écriture via code vba
Réponses
10
Affichages
907
soan
S
U
  • Question Question
Autres [RESOLU] Application.ScreenUpdating = False
Réponses
4
Affichages
1 K
un internaute
U
D
  • Question Question
Microsoft 365 Modification d'un code VBA
Réponses
8
Affichages
1 K
Hasco
L
  • Question Question
Microsoft 365 Compter et afficher un numéro correspondant à un filtre sélectionné
Réponses
2
Affichages
1 K
Legendre
L
F
  • Question Question
XL 2019 Ajout de condition dans une VBA
Réponses
1
Affichages
1 K
CHALET53
C
A
  • Résolu(e)
XL 2016 Macro consolidation plusieurs fichiers en 1 seul
Réponses
8
Affichages
2 K
Alan28
A
M
  • Question Question
XL 2013 Copier plusieurs onglets vers un autre classeur
2
Réponses
27
Affichages
3 K
MCMAL
M
Menu
Connexion
S'inscrire
Les cookies sont requis pour utiliser ce site. Vous devez les accepter pour continuer à utiliser le site. En savoir plus…