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:

momo

XLDnaute Occasionnel
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:

Après essai, ca marche tjrs pas

Par contre mes excuses, pour la formule, la 2e condition c'était <>"" je voulais mettre
 

momo

XLDnaute Occasionnel
Non, c'est une faute de frappe, le nom de la fonction VBA est VarType. Elle renvoie une valeur de l'énumération VbVarType.
Bonjour Dranreb

Je me permets de t'écrire pour comprendre une erreur dans le code que tu m'as aidé à écrire

Cette erreur n'était jamais apparue jusqu'à aujourd'hui

Erreur 91 sur cette ligne:
Set RngDon = Intersect(Wsh.[12:1000000], Wsh.UsedRange): If RngDon.Rows.Count = 1 And RngDon.Columns.Count _
= 1 Then ReDim T(1 To 1, 1 To 1): T(1, 1) = RngDon.Value Else T = RngDon.Value

je ne sais pas ce qui à bien pu causer ca

Le truc bizarre c'est que le même code dans un autre fichier et tout marche impec
 
Dernière édition:

momo

XLDnaute Occasionnel
J'ai rajouté cette ligne, mais du coup la macro ne masque plus les lignes

If RngDon Is Nothing Then MsgBox "La plage n'a pas pue être définie sur la feuille '" & _ Wsh.Name & "' car la zone utilisée dans celle-ci est seulement '" & _ Wsh.UsedRange.Address(0, 0) & "' !": Exit Sub
 
Dernière édition:

Dranreb

XLDnaute Barbatruc
Bonsoir.
Se pourrait-il que pour certaines feuilles il n'y ait rien à partir de la ligne 12, seulement éventuellement des choses avant, bien que vous m'ayez dit que la ligne 12 contenait toujours des titres sur toutes les feuilles ?
 

momo

XLDnaute Occasionnel
Oui en effet .
Bonsoir.
Se pourrait-il que pour certaines feuilles il n'y ait rien à partir de la ligne 12, seulement éventuellement des choses avant, bien que vous m'ayez dit que la ligne 12 contenait toujours des titres sur toutes les feuilles ?
Oui en effet c’est ce que j’avais dit .. mais entre temps j’ai créé une feuille accueil ou il n’y a rien de mis à partir de la ligne 12 ... je comprends mtn
 

Discussions similaires

Membres actuellement en ligne

Statistiques des forums

Discussions
311 725
Messages
2 081 941
Membres
101 848
dernier inscrit
Djigbenou