[MACRO] Enregistrement format PDF

Bonjour,

Je me permets de poster ici pour obtenir de l'aide pour la création d'une macro qui dépasse mes compétences. Avant d'aborder cette macro voici une briève présentation du document en question. J'espère que celle-ci vous aidera à mieux comprendre mon objectif.

Il s'agit d'un fichier excel pour le chiffrage de boucle logistique permettant de dupliquer des documents dans chaque format client. Il y a 10 onglets de travail, et les informations présentes dans ses onglets sont dupliquées dans différents formats dans les onglets orange bleu et rouge.

On a donc :

Onglet 1 à 10 => Les onglets de travail, d'ou viennent les informations appelés dans les onglets suivants.

Et les onglets client:

Onglet 11 à 20 => Format Q

Onglet 21 à 30 => Format A

Onglet 31 à 40 => Format DT

Les onglets CHARGE et BIBLE ne nous intéresse pas ici, mais je les ai volontairement laissé afin d'être sur qu'il ne génère pas d'erreur.

J'utilise actuellement une macro permettant de créer des PDF pour chacun des onglets. Elle créer un dossier "RÉCEPTION PDF", enregistre à l'intérieur un document PDF pour chacun des onglets et les nomme en fonction de ce que contient la cellule D12 pour les onglets Q, D4 pour les onglets A et K2 pour les onglets DT. (Je précise que les cellule D12, D4 et K2 renvoie tous à la même cellule dans les onglets de travail).

Sub PDF_ter()
Dim nom, adr, ub%, chemin$, w As Worksheet, x$, i%
nom = Array("#*Q", "#*A", "#*DT")
adr = Array("D12", "D4", "K2")
ub = UBound(nom)
chemin = ThisWorkbook.Path & "\RECEPTION PDF\" '"C:\Users\amazet\Desktop\RECEPTION PDF\"
If Dir(chemin) = "" Then MkDir chemin 'création du sous-dossier
For Each w In Worksheets
    x = w.Name
    For i = 0 To ub
        If x Like nom(i) Then
            w.ExportAsFixedFormat xlTypePDF, chemin & x & " - " & w.Range(adr(i))
            Exit For
        End If
Next i, w
End Sub

J'aimerais aujourd'hui améliorer cette macro en plusieurs points:

  • Le point principal est le suivant : plutôt que d'obtenir un PDF pour chaque onglet, je souhaiterais obtenir un PDF pour chaque scénario, en excluant les onglets de travail. C'est à dire retrouver dans mon dossier RECEPTION PDF un PDF n°1 comprenant l'onglet A1, Q1 et DT1, puis un second fichier comprenant l'onglet A2, Q2 et DT2, etc.....

[list]

  • Ensuite, il n'est pas nécessaire de créer des fichiers PDF pour les onglets qui ne sont pas remplis. Dans mes fiches de travail (onglet 1 à 10), si la cellule [i4] n'est pas remplie, la macro ne doit pas créer de fichier PDF. La cellule [i4] contient le nom du scénario.

    Merci d'avance et bonne journée.

  • Bonjour Truemate,

    Un exemple EXCEL serait le bienvenu...

    Bonjour,

    Ci-joint mon fichier avec macro (allégé).

    Bonsoir Truemate

    Ma proposition :

    Sub PDF_GVS()
        Dim oSheet As Worksheet
        Dim oCell As Range
        Dim oFS As Object
    
        Dim i As Integer, iNb As Integer
        Dim aSheetNames() As String
        Dim Chemin As String
    
        Set oFS = CreateObject("Scripting.FilesystemObject")
    
        Chemin = ThisWorkbook.Path & "\RECEPTION PDF\" '"C:\Users\amazet\Desktop\RECEPTION PDF\"
        If Not oFS.Folderexists(Chemin) Then
            oFS.createfolder (Chemin)
        End If
    
        'Décompte des feuilles dont le nom est un nombre
        For Each oSheet In ThisWorkbook.Worksheets
            If IsNumeric(oSheet.Name) Then
                ReDim Preserve aSheetNames(i)
                aSheetNames(i) = oSheet.Name
                i = i + 1
            End If
        Next
    
        'On boucle sur les feuilles dont le nom est un nombre
        For i = 0 To UBound(aSheetNames)
            Set oSheet = ThisWorkbook.Worksheets(aSheetNames(i))
            'On contrôle que le nom de scénario est présent
            Set oCell = oSheet.Range("I4")
            If Not IsEmpty(oCell.Value) Then
                'On sélectionne toutes les feuilles Qx, Ax, DTx pour le PDF
                ThisWorkbook.Worksheets(Array(aSheetNames(i) & "Q", aSheetNames(i) & "A", aSheetNames(i) & "DT")).Select
                'On créé le MDF
                ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=Chemin & "PDF" & aSheetNames(i) & ".pdf", _
                Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
            End If
        Next
    
    End Sub

    Bonjour GVIALLES,

    Merci pour ta proposition, c'est vraiment un excellent travail.

    Pourrais-tu ajouter une ligne pour nommer les PDF en fonction du nom rentré dans le cellule [i4] pour chaque feuille ? C'est à dire que le PDF1 serait renommé "='1'!i4".pdf, le PDF2 ='2'!i4, etc....

    Merci d'avance.

    Bonjour Truemate,

    Il suffit que tu modifies :

         ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=Chemin & "PDF" & aSheetNames(i) & ".pdf", _
                Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False

    en

         ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=Chemin & ocell.Value & aSheetNames(i) & ".pdf", _
                Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False

    Dis-moi au cas où tu ne t'en sortirais pas...

    C'est bon

    Merci beaucoup !

    Bonjour,

    Je me permets de remonter le sujet pour une petite maj de macro que je ne parviens pas à mettre en oeuvre.

    Parmis les macros que j'utilise, il y a celle-ci (qui enregistre indépendamment chaque page) :

    Sub PDF_ter()

    Dim nom, adr, ub%, Chemin$, w As Worksheet, x$, i%

    nom = Array("#*Q", "#*A", "#*DT")

    adr = Array("D51", "F5", "N2")

    ub = UBound(nom)

    Chemin = ThisWorkbook.Path & "\RECEPTION PDF FEUILLE\" '"C:\Users\amazet\Desktop\RECEPTION PDF FEUILLE\"

    If Dir(Chemin) = "" Then MkDir Chemin 'création du sous-dossier

    For Each w In Worksheets

    x = w.Name

    For i = 0 To ub

    If x Like nom(i) Then

    w.ExportAsFixedFormat xlTypePDF, Chemin & x & " - " & w.Range(adr(i))

    Exit For

    End If

    Next i, w

    End Sub

    J'aimerais la modifier pour ajouter le paramètre suivant : si il n'y a pas de nom dans les cellule D51 pour les onglets #*Q, F5 pour les onglets #*A et N2 pour les onglets #*DT, alors le programme ne génère tout simplement pas de pdf pour la feuille en question.

    A titre d'exemple, actuellement la macro génère systématiquement 30 pdf, même si je n'utilise que les 3 premiers onglets. On retrouve bien les 3 pdf mais également 27 pdf qui se nomme "2A-0.pdf", "3A-0.pdf", etc...... J'aimerais faire disparaitre ces opérations inutiles.

    Merci d'avance et bonne journée.

    Bonjour TrueMate

    Je te propose le code suivant :

    Sub PDF_ter_GVS()
    Dim nom, adr, ub%, Chemin$, w As Worksheet, x$, i%
    nom = Array("#*Q", "#*A", "#*DT")
    adr = Array("D51", "F5", "N2")
    ub = UBound(nom)
    Chemin = ThisWorkbook.Path & "\RECEPTION PDF FEUILLE\" '"C:\Users\amazet\Desktop\RECEPTION PDF FEUILLE\"
    If Dir(Chemin) = "" Then MkDir Chemin 'création du sous-dossier
    For Each w In Worksheets
    x = w.Name
    For i = 0 To ub
    If x Like nom(i) Then
        If Not IsEmpty(w.Range(adr(i)).Value) Then
            w.ExportAsFixedFormat xlTypePDF, Chemin & x & " - " & w.Range(adr(i))
        End If
    Exit For
    End If
    Next i, w
    End Sub

    Bonjour GVIALLES,

    Petit problème de formulation dans ma demand, je m'explique.

    Les cellules dans lesquelles la macro valide la présence de quelque-chose : les cellules D51 pour les onglets #*Q, F5 pour les onglets #*A et N2 pour les onglets #*DT ne sont jamais vide, elles renvoient à une autre cellule d'un onglet commun., elles contiennent donc soit un nom, soit 0.

    La condition pour ne pas générer de pdf n'est donc pas une cellule vide mais une cellule qui contient 0.

    Merci d'avance.

    Bonjour,

    peut-être en changeant :

    If Not IsEmpty(w.Range(adr(i)).Value) Then

    par :

    If w.Range(adr(i)).Value <>0 Then

    Sinon, j'imagine que tu ne pourras pas m'aider mais, du coup, si quelqu'un sait à quoi servent les # dans la partie de code suivante :

    nom = Array("#*Q", "#*A", "#*DT")

    Ca m'intéresse beaucoup.

    Merci !

    Salut JoyeuxNoel,

    Merci pour ton retour, cela fonction parfaitement.

    Si ca peut aider à répondre a ta question : ce fichier comporte 10 feuilles A, puis 10 feuilles Q et enfin 10 feuilles DT, comme ceci :

    Q1 Q2 Q3 Q4 Q5 Q6 Q7 Q8 Q9 Q10 A1 A2 A3 A4 A5 A6 A7 A8 A9 A10 DT1 DT2 DT3 DT4 DT5 DT6 DT7 DT8 DT9 DT10

    Les # renvoie vers les différents numéros d'onglets.

    Cool si ça fonctionne.

    Oui, je vois bien que ça renvoie aux différents onglets. Mais j'avais tendance à penser que "*A" ferait le même boulot, sans le #.

    D'où mon interrogation sur son utilité.

    Sinon, j'imagine que tu ne pourras pas m'aider mais, du coup, si quelqu'un sait à quoi servent les # dans la partie de code suivante :

    nom = Array("#*Q", "#*A", "#*DT")

    Ca m'intéresse beaucoup.

    A priori,

    # signifie tout chiffre (0 à 9)

    * signifie un ou plusieurs caractères, voire zéro caractère

    https://docs.microsoft.com/fr-fr/dotnet/visual-basic/language-reference/operators/like-operator

    Il faut regarder la macro pour connaître le contexte de ce # !

    Chouette, merci pour l'info !

    Du coup, dans ce cas-là il ne sert à rien parce que le "*" est plus générique, non ?

    Si ca peut aider à répondre a ta question : ce fichier comporte 10 feuilles A, puis 10 feuilles Q et enfin 10 feuilles DT, comme ceci :

    Q1 Q2 Q3 Q4 Q5 Q6 Q7 Q8 Q9 Q10 A1 A2 A3 A4 A5 A6 A7 A8 A9 A10 DT1 DT2 DT3 DT4 DT5 DT6 DT7 DT8 DT9 DT10

    Les # renvoie vers les différents numéros d'onglets.

    Du coup, dans ce cas-là il ne sert à rien parce que le "*" est plus générique, non ?

    En fait, les feuilles ne s'appellent pas Q1 Q2 etc, mais 1Q, 2Q etc ... d'où le # pour spécifier que cela doit commencer par un chiffre et non pas n'importe quoi !

    merci pour les infos, steelson

    Bonjour Truemate,

    En ce cas, essaies le code suivant :

    Sub PDF_ter_GVS()
    Dim nom, adr, ub%, Chemin$, w As Worksheet, x$, i%
    nom = Array("#*Q", "#*A", "#*DT")
    adr = Array("D51", "F5", "N2")
    ub = UBound(nom)
    Chemin = ThisWorkbook.Path & "\RECEPTION PDF FEUILLE\" '"C:\Users\amazet\Desktop\RECEPTION PDF FEUILLE\"
    If Dir(Chemin) = "" Then MkDir Chemin 'création du sous-dossier
    For Each w In Worksheets
    x = w.Name
    For i = 0 To ub
    If x Like nom(i) Then
        'If Not IsEmpty(w.Range(adr(i)).Value) Then
        If Not w.Range(adr(i)).Value = 0 Then
            w.ExportAsFixedFormat xlTypePDF, Chemin & x & " - " & w.Range(adr(i))
        End If
    Exit For
    End If
    Next i, w
    End Sub
    Rechercher des sujets similaires à "macro enregistrement format pdf"