MACRO Enregistrement pdf nominatif

Antoine MAZET

XLDnaute Nouveau
Bonjour,
Dans le cadre de mon travail je manipule chaque jour un fichier excel qui comprend 43 onglets différents. J'aimerais utiliser une macro me permettant d'imprimer chacun de ces onglets (une page par onglet) en lui donnant un nom différent à chaque fois.

Parmi ces 43 onglets avons dans l'ordre :
- De 1 à 10 = ces onglets nous importe peu
- De 11 à 20 = onglets Q1; Q2; Q3; Q4; Q5; Q6; Q7; Q8; Q9; Q10
- De 21 à 30 = onglets A1; A2; A3; A4; A5; A6; A7; A8; A9; A10
- De 31 à 40 = onglets DT1; DT2; DT3; DT4; DT5; DT6; DT7; DT8; DT9; DT10
-De 41 0 43 = ces onglets nous importe peu

7c1496dde7b8109d75aa764a7b74d119-full.jpg


J'aimerais donc utiliser une macro qui me permettrait d'enregistrer en format PDF les onglets Q1 à Q10 + A1 à A10 + DT1 à DT10 en les nommant de la manière suivante :
- Q1 - (Nom renseigné en cellule [D12] de la feuille en question)
- A1 - (Nom renseigné en cellule [D4] de la feuille en question)
- DT1 - (Nom renseigné en cellule [K2] de la feuille en question)

Pour le moment j'utilise la fonction suivante :

Sub Macro1()
For i = 1 To Sheets.Count
Sheets(i).Select
ChDir "C:\Users\amazet\Desktop"
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:="C:\Users\amazet\Desktop\feuille_" & i & ".pdf"
Next i
End Sub

Elle me permet d'imprimer toutes les pages en PDF en un seul clique, mais je dois rentrer ensuite chaque nom à la main ce qui me fait perdre un temps fou....

Si quelqu'un sait améliorer cette formule, je suis preneur....
Merci d'avance et bonne journée !
 

Staple1600

XLDnaute Barbatruc
Bonjour le fil, le forum

Essaies avec cette modif de ta macro
VB:
Sub Macro1b()
Dim i
ChDir "C:\Users\amazet\Desktop"
For i = 1 To Sheets.Count
With Sheets(i)
.ExportAsFixedFormat Type:=xlTypePDF, Filename:="C:\Users\amazet\Desktop\feuille_" & .Name & ".pdf"
End With
Next i
End Sub
 

Antoine MAZET

XLDnaute Nouveau
Merci Staple1600, c'est un bon début d'amélioration.
Maintenant les fichiers PDF porte effectivement le nom de l'onglet en question.

Sais-tu comment ajouter un nom associer à une cellule ? Voici les chemins pour les cellules suivantes :
- Sheet 11 à 20Q1 - (Nom renseigné en cellule [D12] de la feuille en question)
- Sheet 21 à 30A1 - (Nom renseigné en cellule [D4] de la feuille en question)
- Sheet 31 à 40DT1 - (Nom renseigné en cellule [K2] de la feuille en question)

Egalement supprimer complètement l'enregistrement des onglets 1 à 10 ?
D'avance merci.
 

Antoine MAZET

XLDnaute Nouveau
Merci pour le tuyau,
Seulement j'ai oublié de préciser que je ne maîtrise absolument pas VBA... Peut être que ça simplifierait le code si je définissais le nom souhaité de chaque feuille dans une cellule identique, Par exemple AB50 pour toutes les feuilles ?

Si quelque peut m'aider à améliorer le code....
Merci d'avance
 

KVL

XLDnaute Nouveau
Merci Staple1600, c'est un bon début d'amélioration.
Maintenant les fichiers PDF porte effectivement le nom de l'onglet en question.

Sais-tu comment ajouter un nom associer à une cellule ? Voici les chemins pour les cellules suivantes :
- Sheet 11 à 20Q1 - (Nom renseigné en cellule [D12] de la feuille en question)
- Sheet 21 à 30A1 - (Nom renseigné en cellule [D4] de la feuille en question)
- Sheet 31 à 40DT1 - (Nom renseigné en cellule [K2] de la feuille en question)

Egalement supprimer complètement l'enregistrement des onglets 1 à 10 ?
D'avance merci.


Je vois 3 choses à faire :

1. Pour limiter des feuilles de 11 à 40 uniquement :
For i = 11 to 40

Condition : 1. le nombre de feuilles reste toujours identique ( max 43 )
2. leur ordre reste invariable

2. Choisir le nom en fonction du contenu d'une cellule définie (et toujours la même ) :
==> Utiliser un Select Case ; la variable nom s'appelle PDFName ( string )

Select Case i ' choisir en fonction de i

Case 11 To 20
PDFName = "Feuille_" & i & "_" & Range("D12").value
Case 21 To 30
PDFName = "Feuille_" & i & "_" & range("D4").value
Case 31 To 40
PDFName = "Feuille_" & i & "_" & range("K2").value
Case Else ' pour les autres cas ou cas d'erreur
msgbox "Erreur"

End Select


3. Pour finir, remplacer le nom dans :
Filename:="C:\Users\amazet\Desktop\" & PDFName & ".pdf"

Les fichiers PDF s'appelleront donc C:\Users\amazet\Desktop\PDFName.pdf".
Et ressembleront à ( supposons que le contenu de D12 = "ABCD" ) :
C:\Users\amazet\Desktop\Feuille_17_ABCD
C:\Users\amazet\Desktop\Feuille_18_EFGH
C:\Users\amazet\Desktop\Feuille_19_JKLM
etc.


Bàt,
 
Dernière édition:

Antoine MAZET

XLDnaute Nouveau
Salut KVL,
Merci pour tes conseils. Je peux ajouter les éléments que tu m'as donné au code que j'utilisais déjà ?

Celui ci :
Sub Macro1b()
Dim i
ChDir "C:\Users\amazet\Desktop"
For i = 1 To Sheets.Count
With Sheets(i)
.ExportAsFixedFormat Type:=xlTypePDF, Filename:="C:\Users\amazet\Desktop\feuille_" & .Name & ".pdf"
End With
Next i
End Sub

Merci d'avance
 

KVL

XLDnaute Nouveau
Salut KVL,
Merci pour tes conseils. Je peux ajouter les éléments que tu m'as donné au code que j'utilisais déjà ?

Celui ci :
Sub Macro1b()
Dim i
ChDir "C:\Users\amazet\Desktop"
For i = 1 To Sheets.Count
With Sheets(i)
.ExportAsFixedFormat Type:=xlTypePDF, Filename:="C:\Users\amazet\Desktop\feuille_" & .Name & ".pdf"
End With
Next i
End Sub

Merci d'avance



Après Dim i as integer (*), insérer la ligne Dim PDFName as string
(*) pour éviter les erreurs d'overflow ou de type, toujours indiquer le type de variable. par exemple: Dim i AS INTEGER.

Remplacer
For i = 1 To Sheets.Count
par
For i = 11 to 40

Remplacer .ExportAsFixedFormat etc .... par le bloc CASE / EXPORT


RESULTAT : ( A tester évidemment ) :

Sub Macro1b()

Dim i as integer
Dim PDFName as string

ChDir "C:\Users\amazet\Desktop"

For i = 11 to 40

With Sheets(i)

Select Case i ' choisir en fonction de i
Case 11 To 20
PDFName = "Feuille_" & i & "_" & Range("D12").value
Case 21 To 30
PDFName = "Feuille_" & i & "_" & Range("D4").value
Case 31 To 40
PDFName = "Feuille_" & i & "_" & Range("K2").value
Case Else ' pour les autres cas ou cas d'erreur
msgbox "Erreur"
End Select

.ExportAsFixedFormat Type:=xlTypePDF, Filename:="C:\Users\amazet\Desktop\" & PDFName & ".pdf"

End With

Next i

End Sub
 

job75

XLDnaute Barbatruc
Bonsoir Antoine MAZET, JM, KVL,

Il pourrait se faire qu'il manque des feuilles ou surtout que leur ordre soit modifié, vous ne croyez pas ?

Avec cette macro il n'y aura pas de problème :
Code:
Sub PDF()
Dim tablo, chemin$, w As Worksheet, adr As Variant
tablo = [{"Q","D12";"A","D4";"D","K2"}] 'tableau de correspondance
chemin = ThisWorkbook.Path & "\" '"C:\Users\amazet\Desktop\"
For Each w In Worksheets
    If w.Name Like "*#*" Then 'sécurité
        adr = Application.VLookup(Left(w.Name, 1), tablo, 2, 0)
        If Not IsError(adr) Then w.ExportAsFixedFormat xlTypePDF, chemin & w.Name & " - " & w.Range(adr)
    End If
Next
End Sub
A+
 

job75

XLDnaute Barbatruc
Re,

Je préfère cette 2ème macro car la sécurité est meilleure :
Code:
Sub PDF_bis()
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 & "\" '"C:\Users\amazet\Desktop\"
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
A+
 

Pièces jointes

  • PDF(1).xlsm
    24.2 KB · Affichages: 38

Antoine MAZET

XLDnaute Nouveau
Salut Job 75,
Merci d'avoir pris le temps de me répondre. Ce que tu m'as proposé plus haut marche vraiment très bien. J'aimerais maintenant modifier le dossier de réception de touts ces fichiers, histoire que mon bureau ne soit pas systématiquement inondé de fichier....

Je pensais que modifier simplement "C:\Users\amazet\Desktop\" en "C:\Users\amazet\Desktop\RECEPTION PDF" suffirait, mais cela ne fonctionne pas. En fait le fichier enregistre les PDF la ou il se trouve, peu importe ce que je rentre comme destination. A la limite ça ne pose pas de problème, mais j'aimerais être sur que c'est bien le comportement souhaité !

Merci d'avance pour vos retours.
A+
 

job75

XLDnaute Barbatruc
Bonjour Antoine, le forum,

Pour créer un sous-dossier il faut utiliser MkDir :
Code:
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
Bonne journée.
 

Pièces jointes

  • PDF(2).xlsm
    29.5 KB · Affichages: 31
Haut Bas