XL 2013 Optimisation d'une macro

momo

XLDnaute Occasionnel
Bonjour à tous

J'ai cette macro qui me permet de faire un export sous PDF de plusieurs onglets au choix avec Masquage de lignes sous condition (que le les valeurs de deux colonnes comportent simultanément 0)

La macro fonction bien à condition d'avoir un petit fichier et de petits tableaux de quelques lignes

Par contre lorsque je l'intègre à un fichier de 70 Onglets avec des tableaux très longs, elle rame, juste pour lancer le Userform, au bout de 30 min elle n'y arrive pas

Je voudrais vos conseils pour arriver à l'optimiser.

VB:
Private Sub CmdExportPDF_Click()
Dim Chemin$, Fiche$, NomFiche$
Dim SheetArray() As Variant
Dim I&, Indx&
    Chemin = ThisWorkbook.Path & Application.PathSeparator
    Fiche = "Test"
Indx = 0
    For I = 0 To LbFeuilles.ListCount - 1
        If LbFeuilles.Selected(I) Then
            ReDim Preserve SheetArray(Indx)
            SheetArray(Indx) = LbFeuilles.List(I)
            Indx = Indx + 1
        End If
    Next I
    If Indx > 0 Then
      Application.ScreenUpdating = False
        Sheets(SheetArray()).Select
        NomFiche = Chemin & Fiche
           ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, _
              Filename:=NomFiche, _
              Quality:=xlQualityMinimum, _
              IncludeDocProperties:=True, _
              IgnorePrintAreas:=False, _
              OpenAfterPublish:=False
    End If
Erase SheetArray
Feuil1.Select
    Unload Me
Application.Goto [A1], True
End Sub
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
Dim Cellules As Range
    For N = 1 To Sheets.Count
        For Each Cellules In Sheets(N).UsedRange
            If Cellules = "Année N" And Cellules.Offset(0, 1) = "Année N-1" Then
                ' Réouverture des lignes masquées
                Sheets(N).Cells.EntireRow.Hidden = False
            End If
        Next
    Next N
End Sub
 

Pièces jointes

  • Imprimer_V2 (2).xls
    101 KB · Affichages: 27
Dernière édition:

Dranreb

XLDnaute Barbatruc
Déclarez toutes vos variables, c'est une bonne habitude.
Avec Option Explicit en tête du module la mise au point est plus facile: Il ne tente pas d'exécution tant que des déclarations manquent et les message de compilation sont plus clairs que les message d'exécution résultant des mêmes oublis.
 

momo

XLDnaute Occasionnel
Déclarez toutes vos variables, c'est une bonne habitude.
Avec Option Explicit en tête du module la mise au point est plus facile: Il ne tente pas d'exécution tant que des déclarations manquent et les message de compilation sont plus clairs que les message d'exécution résultant des mêmes oublis.

C'est fait,

Mais le Masquage des ligne à 0 ne se fait toujours pas lors de l'export en PDF
 

Pièces jointes

  • Test.xlsm
    171.9 KB · Affichages: 16

Dranreb

XLDnaute Barbatruc
Définissez les UsedRange partout de la même façon, et si ça implique des cellules non vides devant, au lieu de 1 spécifiez le numéro de la ligne de titres relatif au début de la plage. Et tant qu'à faire faites commencer la boucle sur L non à 2 mais à ce N° + 1.
Vous pourriez aussi mettre les plages sous forme de tableau Excel, ainsi ils seraient couverts par des ListObject, pourvus des propriétés HeaderRowRange, DataBodyRange et ListColumns.
 
Dernière édition:

momo

XLDnaute Occasionnel
Définissez les UsedRange partout de la même façon, et si ça implique des cellules non vides devant, au lieu de 1 spécifiez le numéro de la ligne de titres relatif au début de la plage. Et tant qu'à faire faites commencer la boucle sur L non à 2 mais à ce N° + 1.
Vous pourriez aussi mettre les plages sous forme de tableau Excel, ainsi ils seraient couverts par des ListObject, pourvus des propriétés HeaderRowRange, DataBodyRange et ListColumns.
Hahahha

Vous avez surestimé mes capacités VBA... Je suis plus qu'un débutant. En fait j'essaie de mettre en place un fichier pour mes collaborateurs et moi.

Si seulement vous pouviez me donner une piste dans la macro que vous m'avez déjà écrite et qui niveau rapidité est vraiment top.... j'avoue que ca m'arrangerait
 

Dranreb

XLDnaute Barbatruc
Okay.. les titres sur les lignes de mon fichier se truvent tjrs en ligne 12.
Bon alors définissez RngDon comme ça :
Set RngDon = Intersect(Wsh.[12:1000000], Wsh.UsedRange)
Comme ça sa propre ligne 1 sera toujours la ligne 12 de la feuille.
S'il ne risque plus d'y avoir de feuille avec une seule cellule renseignée comme dans le fichier de test ça ne sert plus à rien de traiter le cas: affectez juste T = RngDon.Value
 
Dernière édition:

momo

XLDnaute Occasionnel
Bon alors définissez RngDon comme ça :
Set RngDon = Intersect(Wsh.[12:1000000], Wsh.UsedRange)
Comme ça sa propre ligne 1 sera toujours la ligne 12 de la feuille.
S'il ne risque plus d'y avoir de feuille avec une seule cellule renseignée comme dans le fichier de test ça ne sert plus à rien de traiter le cas: affectez juste T = RngDon.Value

C'est parfait ca marche Impec,

sur mon fichier les cellules à masque sont sur des onglets qui commencent tous par le même nom

mapomme m'avait aidé dans ce sens avec le code ci-dessous

Private Sub Workbook_SheetActivate(ByVal Sh As Object)
Const PreFix = "Parent"
Dim i&, col1$, col2$
If LCase(Sh.Name) Like LCase(PreFix) & "*" Then
With Sh
If LCase(.Range("d2")) = "kom" Then
' cas des colonnes C et D -> type M1
col1 = "c": col2 = "d"
ElseIf LCase(.Range("d2")) = "mok" Then
' cas des colonnes D et E -> type M2
col1 = "d": col2 = "e"
Else
Exit Sub
End If
Application.ScreenUpdating = False
.UsedRange.EntireRow.Hidden = False
For i = .Cells(.Rows.Count, "d").End(xlUp).Row To 3 Step -1
.Rows(i).Hidden = (.Cells(i, col1) = 0) And (.Cells(i, col2) = 0)
Next i
Application.ScreenUpdating = True
End With
End If
End Sub

Mais je ne sais pas l'adapter au code que vous m'avez aidé à réaliser

Je pense que ca augmenterait l'efficacité de l'optimisation
 

momo

XLDnaute Occasionnel
Vous pouvez soumettre tout le code entre For Each Wsh In ThisWorkbook.Worksheets et Next Wsh à une condition
If LCase(Wsh.Name) Like "parent*" Then. Ne pas oublier de finir par une End If.

Ok je le fais .. j’ai du me planter tout à l’heure en le faisant alors parce que à chaque fois ça me renvoyait des alertes
Et puis je crois que à un niveau il y a un With à insérer et Lcase à mettre à un autre niveau
 

momo

XLDnaute Occasionnel
Ça doit être parce qu'il n'existe aucune feuille dont le nom, mis en minuscules, commence par "parent"
C'est un bout de code, pas une procédure. Une procédure c'est une Sub …

Oui en effet c'est un bout de code.. Sorry...

Par contre pour le nom, en réalité sur mes feuilles de clacul, le "P" est en majuscule et le reste en miniscule

Donc je l'ai écrit tel quel en commençant par la lettre majuscule et le reste en miniscule.

Pensez vous que si j'ajoute dans le code la forumule suivante , ca marchera

If T(L, C) = 0 And If T(L, C) <> 0 And T(L, C + 1) = 0 And T(L, C + 1) <> 0 Then

En fait le masque prend des lignes en dessous de mon tableau (Ces lignes au niveau des colonnes Roc et Cor sont vide mais ne le sont pas en debut de feuilles. du coup la macro les masque quand même.

Par cette formule je voulais qu'elle ne prenne pas les lignes vide
 

Dranreb

XLDnaute Barbatruc
Alors mettre simplemet If Wsh.Name = "Parent*" pas If LCase(Wsh.Name) Like "parent*"
Non, ce test n'est pas correct syntaxiquement et n'a aucun sens. C'est soit If T(L, C) = 0 And T(L, C + 1) = 0 Then soit la conditiion inverse If T(L, C) <> 0 Or T(L, C + 1) <> 0 Then:
 

Discussions similaires