Macro Excel - Mise en page [Résolu/Fermé]

Signaler
Messages postés
3
Date d'inscription
vendredi 13 novembre 2009
Statut
Membre
Dernière intervention
13 novembre 2009
-
Messages postés
12185
Date d'inscription
jeudi 15 mai 2008
Statut
Modérateur
Dernière intervention
21 septembre 2020
-
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.

5 réponses

Messages postés
12185
Date d'inscription
jeudi 15 mai 2008
Statut
Modérateur
Dernière intervention
21 septembre 2020
2 484
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.
Messages postés
3
Date d'inscription
vendredi 13 novembre 2009
Statut
Membre
Dernière intervention
13 novembre 2009

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)
Messages postés
12185
Date d'inscription
jeudi 15 mai 2008
Statut
Modérateur
Dernière intervention
21 septembre 2020
2 484
ç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à.
Messages postés
3
Date d'inscription
vendredi 13 novembre 2009
Statut
Membre
Dernière intervention
13 novembre 2009

Tu es génial :)
Grâce à toi j'ai réussi à avoir le résultat que je voulais.
Mille mercis
Messages postés
12185
Date d'inscription
jeudi 15 mai 2008
Statut
Modérateur
Dernière intervention
21 septembre 2020
2 484
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.