Macro Excel - Mise en page
Résolu
Vanex
Messages postés
3
Date d'inscription
Statut
Membre
Dernière intervention
-
pijaku Messages postés 12263 Date d'inscription Statut Modérateur Dernière intervention -
pijaku Messages postés 12263 Date d'inscription Statut Modérateur Dernière intervention -
Bonjour,
Depuis hier je me creuse les méninges pour essayer de construire une macro tout seul, n'ayant jamais fait de VBA je galère un petit peu.
Je voudrais mettre en forme un rapport de plusieurs feuilles, c'est à dire:
1) Feuille1:
- Supprimer la première ligne.
- Supprimer la ligne avant la dernière ligne écrite et la ligne après la dernière ligne écrite ( ex: Si la dernière ligne est la 36, il faut supprimer la 35 et la 37).
- Supprimer la colonne 'K'
2) Feuille2:
- Supprimer la ligne avant la dernière ligne écrite et la ligne après la dernière ligne écrite ( ex: Si la dernière ligne est la 36, il faut supprimer la 35 et la 37).
- Supprimer la colonne 'K'
3)Feuille3:
- Supprimer la ligne après la dernière ligne écrite.
-Supprimer la colonne 'K'
4) Mise en page:
-J'aimerais bien que la macro renomme automatiquement mes trois feuilles.
- Que la zone d'impression soit définie en fonction de la dernière ligne. (Il est possible que des lignes se rajoutent en fonction du mois).
-Définir les marges et le pourcentage (pour que le fichier soit prêt à être imprimer directement).
Je vous laisse mon bout de code,
En espérant que quelqu'un puisse m'aider, bonne journée à tous.
Quentin.
Sheets("Feuille1").Select
Columns("K:K").Delete Shift:=xlToLeft
Rows("1:1").Delete Shift:=xlUpe
Dim Lastlig As Long
Lastlig = 1
For i = 1 To 256
If Sheets(1).Cells(65500, i).End(xlUp).Row > Lastlig Then
Lastlig = Sheets(1).Cells(6500, i).End(xlUp).Row
End If
Next i
Sheets(1).Rows(Lastlig + 1 & ":" & Lastlig + 1).EntireRow.Delete Shift:=xlUp
Sheets(1).Rows(Lastlig - 1 & ":" & Lastlig - 1).EntireRow.Delete Shift:=xl
Sheets("Feuille2").Select
Columns("K:K").Delete Shift:=xlToLeft
Dim Lastlig2 As Long
Lastlig2 = 1
For i = 1 To 256
If Sheets(1).Cells(65500, i).End(xlUp).Row > Lastlig2 Then
Lastlig2 = Sheets(2).Cells(6500, i).End(xlUp).Row
End If
Next i
Sheets(2).Rows(Lastlig2 + 1 & ":" & Lastlig2 + 1).EntireRow.Delete Shift:=xlUp
Sheets(2).Rows(Lastlig2 - 1 & ":" & Lastlig2 - 1).EntireRow.Delete Shift:=xl
Sheets("Feuille3").Select
Columns("K:K").Delete Shift:=xlToLeft
Dim Lastlig3 As Long
Lastlig3 = 1
For i = 1 To 256
If Sheets(1).Cells(65500, i).End(xlUp).Row > Lastlig3 Then
Lastlig3 = Sheets(3).Cells(6500, i).End(xlUp).Row
End If
Next i
Sheets(3).Rows(Lastlig3 + 1 & ":" & Lastlig3 + 1).EntireRow.Delete Shift:=xlUp
Je vous laisse mon bout de code,
En espérant que quelqu'un puisse m'aider, bonne journée à tous.
Quentin.
Depuis hier je me creuse les méninges pour essayer de construire une macro tout seul, n'ayant jamais fait de VBA je galère un petit peu.
Je voudrais mettre en forme un rapport de plusieurs feuilles, c'est à dire:
1) Feuille1:
- Supprimer la première ligne.
- Supprimer la ligne avant la dernière ligne écrite et la ligne après la dernière ligne écrite ( ex: Si la dernière ligne est la 36, il faut supprimer la 35 et la 37).
- Supprimer la colonne 'K'
2) Feuille2:
- Supprimer la ligne avant la dernière ligne écrite et la ligne après la dernière ligne écrite ( ex: Si la dernière ligne est la 36, il faut supprimer la 35 et la 37).
- Supprimer la colonne 'K'
3)Feuille3:
- Supprimer la ligne après la dernière ligne écrite.
-Supprimer la colonne 'K'
4) Mise en page:
-J'aimerais bien que la macro renomme automatiquement mes trois feuilles.
- Que la zone d'impression soit définie en fonction de la dernière ligne. (Il est possible que des lignes se rajoutent en fonction du mois).
-Définir les marges et le pourcentage (pour que le fichier soit prêt à être imprimer directement).
Je vous laisse mon bout de code,
En espérant que quelqu'un puisse m'aider, bonne journée à tous.
Quentin.
Sheets("Feuille1").Select
Columns("K:K").Delete Shift:=xlToLeft
Rows("1:1").Delete Shift:=xlUpe
Dim Lastlig As Long
Lastlig = 1
For i = 1 To 256
If Sheets(1).Cells(65500, i).End(xlUp).Row > Lastlig Then
Lastlig = Sheets(1).Cells(6500, i).End(xlUp).Row
End If
Next i
Sheets(1).Rows(Lastlig + 1 & ":" & Lastlig + 1).EntireRow.Delete Shift:=xlUp
Sheets(1).Rows(Lastlig - 1 & ":" & Lastlig - 1).EntireRow.Delete Shift:=xl
Sheets("Feuille2").Select
Columns("K:K").Delete Shift:=xlToLeft
Dim Lastlig2 As Long
Lastlig2 = 1
For i = 1 To 256
If Sheets(1).Cells(65500, i).End(xlUp).Row > Lastlig2 Then
Lastlig2 = Sheets(2).Cells(6500, i).End(xlUp).Row
End If
Next i
Sheets(2).Rows(Lastlig2 + 1 & ":" & Lastlig2 + 1).EntireRow.Delete Shift:=xlUp
Sheets(2).Rows(Lastlig2 - 1 & ":" & Lastlig2 - 1).EntireRow.Delete Shift:=xl
Sheets("Feuille3").Select
Columns("K:K").Delete Shift:=xlToLeft
Dim Lastlig3 As Long
Lastlig3 = 1
For i = 1 To 256
If Sheets(1).Cells(65500, i).End(xlUp).Row > Lastlig3 Then
Lastlig3 = Sheets(3).Cells(6500, i).End(xlUp).Row
End If
Next i
Sheets(3).Rows(Lastlig3 + 1 & ":" & Lastlig3 + 1).EntireRow.Delete Shift:=xlUp
Je vous laisse mon bout de code,
En espérant que quelqu'un puisse m'aider, bonne journée à tous.
Quentin.
A voir également:
- Macro Excel - Mise en page
- Mise en forme conditionnelle excel - Guide
- Telecharger macro convertir chiffre en lettre excel - Télécharger - Tableur
- Liste déroulante excel - Guide
- Supprimer page word - Guide
- Imprimer tableau excel sur une page - Guide
5 réponses
Bonjour,
Plusieurs petits soucis avec ta macro.
1- Eviter au maximum les "select". Tu peux donc remplacer :
Sheets("Feuil1").Select
Columns("K:K").Delete Shift:=xlToLeft
Rows("1:1").Delete Shift:=xlUp
par :
With Sheets("Feuil1")
.Columns("K:K").Delete Shift:=xlToLeft
.Rows("1:1").Delete Shift:=xlUp
End With
Note que dans ce cas bien précis (sélection d'une feuille) ça n'est pas grave, mais ça reste, je crois une bonne habitude à prendre.
2- La dernière ligne absolue d'une Feuille Excel s'obtient avec :
Dim Lastlig As Integer
Lastlig = Range("A1").SpecialCells(xlCellTypeLastCell).Row
Attention: Si des lignes sont supprimées dans la plage, enregistrez préalablement le fichier
Mets ce lien dans tes favoris...
3- pourquoi Lastlig2 et Lastlig3 si tu n'as plus besoin de la valeur stockée dans "Lastlig"?
Tu peux très bien utiliser une seule variable si tu n'as plus besoin de la valeur qui lui est affectée.
Concrètement dans ton cas :
Dim Lastlig As Integer
With Sheets("Feuil1")
Lastlig = Range("A1").SpecialCells(xlCellTypeLastCell).Row
Sheets(1).Rows(Lastlig + 1).Delete Shift:=xlUp
End With
With Sheets("Feuil2")
Lastlig = Range("A1").SpecialCells(xlCellTypeLastCell).Row
Sheets(2).Rows(Lastlig + 1).Delete Shift:=xlUp
End With
With Sheets("Feuil3")
Lastlig = Range("A1").SpecialCells(xlCellTypeLastCell).Row
Sheets(3).Rows(Lastlig + 1).Delete Shift:=xlUp
End With
Essaye déjà avec ça et reviens ici si tu as d'autres soucis.
Plusieurs petits soucis avec ta macro.
1- Eviter au maximum les "select". Tu peux donc remplacer :
Sheets("Feuil1").Select
Columns("K:K").Delete Shift:=xlToLeft
Rows("1:1").Delete Shift:=xlUp
par :
With Sheets("Feuil1")
.Columns("K:K").Delete Shift:=xlToLeft
.Rows("1:1").Delete Shift:=xlUp
End With
Note que dans ce cas bien précis (sélection d'une feuille) ça n'est pas grave, mais ça reste, je crois une bonne habitude à prendre.
2- La dernière ligne absolue d'une Feuille Excel s'obtient avec :
Dim Lastlig As Integer
Lastlig = Range("A1").SpecialCells(xlCellTypeLastCell).Row
Attention: Si des lignes sont supprimées dans la plage, enregistrez préalablement le fichier
Mets ce lien dans tes favoris...
3- pourquoi Lastlig2 et Lastlig3 si tu n'as plus besoin de la valeur stockée dans "Lastlig"?
Tu peux très bien utiliser une seule variable si tu n'as plus besoin de la valeur qui lui est affectée.
Concrètement dans ton cas :
Dim Lastlig As Integer
With Sheets("Feuil1")
Lastlig = Range("A1").SpecialCells(xlCellTypeLastCell).Row
Sheets(1).Rows(Lastlig + 1).Delete Shift:=xlUp
End With
With Sheets("Feuil2")
Lastlig = Range("A1").SpecialCells(xlCellTypeLastCell).Row
Sheets(2).Rows(Lastlig + 1).Delete Shift:=xlUp
End With
With Sheets("Feuil3")
Lastlig = Range("A1").SpecialCells(xlCellTypeLastCell).Row
Sheets(3).Rows(Lastlig + 1).Delete Shift:=xlUp
End With
Essaye déjà avec ça et reviens ici si tu as d'autres soucis.
Merci de ton aide pijaku, ca me permet d'apprendre un peu mieux, seulement toute cette partie fonctionne avec mon code, même si c'est fait un petit peu à l'arrache.
J'ai surtout un soucis avec le 4).
Et aussi, dans ton 3) ça ne supprime que la ligne après la derniere non ? (Lastlig + 1)
J'ai surtout un soucis avec le 4).
Et aussi, dans ton 3) ça ne supprime que la ligne après la derniere non ? (Lastlig + 1)
ça ne supprime que la ligne après la derniere non ? (Lastlig + 1) Euh ben oui. Je ne t'apportais qu'une piste pour toi faire ton code.
4) - Renommer les feuilles : cet exemple renomme les feuilles en fonction de ce qu'elles contiennent en A1 :
Sheets(1).Name = Sheets(1).Range("A1")
Sheets(2).Name = Sheets(2).Range("A1")
Sheets(3).Name = Sheets(3).Range("A1")
- Zone d'impression : en fonction de la dernière ligne
Dim Lastlig as integer
Lastlig = Range("A1").SpecialCells(xlCellTypeLastCell).Row
ActiveSheet.PageSetup.PrintArea = "A1:I" & Lastlig
- marges & pourcentage :
Sheets(1).Select
With ActiveSheet.PageSetup
.LeftMargin = Application.InchesToPoints(0.393700787401575) 'corresponds à marge de gauche = "1"
.RightMargin = Application.InchesToPoints(1.18110236220472) 'corresponds à marge de droite = "3"
.TopMargin = Application.InchesToPoints(1.5748031496063) 'corresponds à marge du haut = "4"
.BottomMargin = Application.InchesToPoints(0.78740157480315) 'corresponds à marge du bas = "2"
.HeaderMargin = Application.InchesToPoints(0.511811023622047) 'corresponds à en-tête = "1,3"
.FooterMargin = Application.InchesToPoints(0.511811023622047) 'corresponds à pied de page= "1,3"
.Zoom = 80 'pourcentage à 80%
End With
Voilà.
4) - Renommer les feuilles : cet exemple renomme les feuilles en fonction de ce qu'elles contiennent en A1 :
Sheets(1).Name = Sheets(1).Range("A1")
Sheets(2).Name = Sheets(2).Range("A1")
Sheets(3).Name = Sheets(3).Range("A1")
- Zone d'impression : en fonction de la dernière ligne
Dim Lastlig as integer
Lastlig = Range("A1").SpecialCells(xlCellTypeLastCell).Row
ActiveSheet.PageSetup.PrintArea = "A1:I" & Lastlig
- marges & pourcentage :
Sheets(1).Select
With ActiveSheet.PageSetup
.LeftMargin = Application.InchesToPoints(0.393700787401575) 'corresponds à marge de gauche = "1"
.RightMargin = Application.InchesToPoints(1.18110236220472) 'corresponds à marge de droite = "3"
.TopMargin = Application.InchesToPoints(1.5748031496063) 'corresponds à marge du haut = "4"
.BottomMargin = Application.InchesToPoints(0.78740157480315) 'corresponds à marge du bas = "2"
.HeaderMargin = Application.InchesToPoints(0.511811023622047) 'corresponds à en-tête = "1,3"
.FooterMargin = Application.InchesToPoints(0.511811023622047) 'corresponds à pied de page= "1,3"
.Zoom = 80 'pourcentage à 80%
End With
Voilà.
Vous n’avez pas trouvé la réponse que vous recherchez ?
Posez votre question
De rien. Je reviens néanmoins sur l'aspect rigoureux qu'il faut avoir surtout en débutant. Je n'ai pas eu cette chance et maintenant je galère à faire des codes à peu près propres. Je pensais comme toi "tant que ça fonctionne!!!". Jusqu'au jour ou mon ordi refusait d'ouvrir Excel (quelque soit le fichier) et me coupait régulièrement Internet etc... pour "la mémoire ne peux pas être read...". Les macros mal utilisées, premièrement sont très longues parfois, et deuxièmement peuvent "occuper" un max de place dans la mémoire de ta machine... Eviter les "select" et "purger" les variables est déjà un bon point de départ.
Bonne chance et bon courage pour la suite.
Bonne chance et bon courage pour la suite.