Créer un fichier PDF dans le même répertoire.

W

webmuster

XLDnaute Junior
Bonjour à toutes et à tous

Je me permets de solliciter une fois de plus votre aide.

Grâce au code joint (et à ce forum), j'enregistre, à partir d'une plage sélectionnée (zone d'impression), des fichiers pdf dans le même répertoire.
L'en-tête de cette plage est fonction de la valeur d'une cellule sélectionnée dans une autre plage (A3:A13), dont le nombre et la valeur des cellules non vides est variable, d'où les multiples fichier à créer, et la nécessité de stopper la macro dès qu'une cellule (plage A3:A13) est vide, et d'informer l'utilisateur du succès et de la fin de la procédure.

Ayant élaboré ce code à partir de bribes de réponses de ce forum, et bien qu'il fonctionne, j'imagine qu'il doit exister une manière plus légère de le rédiger, et éviter ainsi les multiples sélections et les répétitions.

En vous remerciant par avance.

Code: 
Sub pdf()

If Sheets("EXTRACTION").Range("A3").Value <> "" Then     
     Range("A3").Select
    ChDir "C:\Desktop"
    ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
        ThisWorkbook.Path & "\" & Range("A3").Value & ".pdf", Quality:=xlQualityStandard, _
        IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:= _
        False        
    Else:  MsgBox "Les fichiers pdf ont été édités avec succès dans le dossier suivant : " & ThisWorkbook.Path & ""
    Exit Sub
      End If
    
  If Sheets("EXTRACTION").Range("A4").Value <> "" Then
  Range("A4").Select   
    ChDir "C:\Desktop"
    ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
        ThisWorkbook.Path & "\" & Range("A4").Value & ".pdf", Quality:=xlQualityStandard, _
        IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:= _
        False        
 Else:  MsgBox "Les fichiers pdf ont été édités avec succès dans le dossier suivant : " & ThisWorkbook.Path & "" 
    Exit Sub
      End If
      
      If Sheets("EXTRACTION").Range("A5").Value <> "" Then
      Range("A5").Select
    ChDir "C:\Desktop"
    ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
        ThisWorkbook.Path & "\" & Range("A5").Value & ".pdf", Quality:=xlQualityStandard, _
        IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:= _
        False           
 Else:  MsgBox "Les fichiers pdf ont été édités avec succès dans le dossier suivant : " & ThisWorkbook.Path & "" 
    Exit Sub
      End If
       
      If Sheets("EXTRACTION").Range("A6").Value <> "" Then
      Range("A6").Select      
    ChDir "C:\Desktop"
    ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
        ThisWorkbook.Path & "\" & Range("A6").Value & ".pdf", Quality:=xlQualityStandard, _
        IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:= _
        False         
   Else:  MsgBox "Les fichiers pdf ont été édités avec succès dans le dossier suivant : " & ThisWorkbook.Path & "" 
    Exit Sub
      End If
     
       If Sheets("EXTRACTION").Range("A7").Value <> "" Then
       Range("A7").Select       
       ChDir "C:\Desktop"
    ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
        ThisWorkbook.Path & "\" & Range("A7").Value & ".pdf", Quality:=xlQualityStandard, _
        IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:= _
        False           
   Else:  MsgBox "Les fichiers pdf ont été édités avec succès dans le dossier suivant : " & ThisWorkbook.Path & "" 
    Exit Sub
      End If
     
        If Sheets("EXTRACTION").Range("A8").Value <> "" Then
        Range("A8").Select          
    ChDir "C:\Desktop"
    ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
        ThisWorkbook.Path & "\" & Range("A8").Value & ".pdf", Quality:=xlQualityStandard, _
        IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:= _
        False           
   Else:  MsgBox "Les fichiers pdf ont été édités avec succès dans le dossier suivant : " & ThisWorkbook.Path & "" 
    Exit Sub
      End If
              
       If Sheets("EXTRACTION").Range("A9").Value <> "" Then
       Range("A9").Select        
    ChDir "C:\Desktop"
    ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
        ThisWorkbook.Path & "\" & Range("A9").Value & ".pdf", Quality:=xlQualityStandard, _
        IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:= _
        False       
   Else:  MsgBox "Les fichiers pdf ont été édités avec succès dans le dossier suivant : " & ThisWorkbook.Path & "" 
    Exit Sub
      End If
     
    If Sheets("EXTRACTION").Range("A10").Value <> "" Then
    Range("A10").Select       
    ChDir "C:\Desktop"
    ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
        ThisWorkbook.Path & "\" & Range("A10").Value & ".pdf", Quality:=xlQualityStandard, _
        IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:= _
        False        
   Else:  MsgBox "Les fichiers pdf ont été édités avec succès dans le dossier suivant : " & ThisWorkbook.Path & "" 
    Exit Sub
      End If
            
    If Sheets("EXTRACTION").Range("A11").Value <> "" Then
    Range("A11").Select        
    ChDir "C:\Desktop"
    ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
        ThisWorkbook.Path & "\" & Range("A11").Value & ".pdf", Quality:=xlQualityStandard, _
        IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:= _
        False            
   Else:  MsgBox "Les fichiers pdf ont été édités avec succès dans le dossier suivant : " & ThisWorkbook.Path & "" 
    Exit Sub
      End If
     
        If Sheets("EXTRACTION").Range("A12").Value <> "" Then
        Range("A12").Select        
    ChDir "C:\Desktop"
    ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
        ThisWorkbook.Path & "\" & Range("A12").Value & ".pdf", Quality:=xlQualityStandard, _
        IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:= _
        False            
   Else:  MsgBox "Les fichiers pdf ont été édités avec succès dans le dossier suivant : " & ThisWorkbook.Path & "" 
    Exit Sub
      End If
     
        If Sheets("EXTRACTION").Range("A13").Value <> "" Then
        Range("A13").Select        
    ChDir "C:\Desktop"
    ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
        ThisWorkbook.Path & "\" & Range("A13").Value & ".pdf", Quality:=xlQualityStandard, _
        IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:= _
        False      
   Else:  MsgBox "Les fichiers pdf ont été édités avec succès dans le dossier suivant : " & ThisWorkbook.Path & "" 
    Exit Sub
      End If     
End Sub

Bien cordialement
 
Trier par date Trier par votes
C

Compte Supprimé 979

Guest
Re : Créer un fichier PDF dans le même répertoire.

Bonjour Webmuster ;)

Je ne suis pas certain de bien avoir tout compris :eek:

Voici un code
Code: 
Sub pdf()
  Dim Cel As Range
  For Each Cel In Sheets("EXTRACTION").Range("A3:A13")
    If Cel.Value <> "" Then
      ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=ThisWorkbook.Path & "\" & Cel.Value & ".pdf", _
                                      Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False


      MsgBox "Les fichiers pdf ont été édités avec succès dans le dossier suivant : " & ThisWorkbook.Path
    Else
      Exit Sub
    End If
  Next Cel
End Sub

A+
 
Vote positif 0 Vote négatif
W

webmuster

XLDnaute Junior
Re : Créer un fichier PDF dans le même répertoire.

Merci BrunoM45

Ton code fonctionne parfaitement en ce qui concerne la création (dans le même répertoire) et la dénomination des fichiers pdf.

Dans le mien, à chaque changement de sélection dans la plage (A3:A13), l'en-tête de la zone d'impression (en L2) prenait sa valeur et la mise à jour des données s'opérait (par macro et formules).
Quand j'utilise ton code, bien que les fichiers créés soit parfaitement dénommés, leurs contenus sont identiques (tous à l'en-tête de la cellule, de la plage (A3:A13), sélectionnée au moment du lancement de la macro).

Enfin, je n'ai besoin d'informer l'utilisateur du succès de la procédure qu'en fin de sélection de la cellule A13, ou lorsque la macro rencontre une cellule vide.

Désolé de complexifier ta recherche.

Cordialement
 
Dernière édition:
Vote positif 0 Vote négatif
W

webmuster

XLDnaute Junior
Re : Créer un fichier PDF dans le même répertoire.

BrunoM45

Je pense avoir résolu mon second problème comme ça:
Code: 
Sub pdf()
  Dim Cel As Range
  For Each Cel In Sheets("EXTRACTION").Range("A3:A13")
    If Cel.Value <> "" Then
    
      ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=ThisWorkbook.Path & "\" & Cel.Value & ".pdf", _
                                      Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
    Else
      MsgBox "Les fichiers pdf ont été édités avec succès dans le dossier suivant : " & ThisWorkbook.Path
      Exit Sub
    End If
  Next Cel
End Sub

Cordialement
 
Vote positif 0 Vote négatif
W

webmuster

XLDnaute Junior
Re : Créer un fichier PDF dans le même répertoire.

Bonjour BrunoM45

Comprenant la difficulté à traiter ma demande sans fichier, je vous laisse en PJ un petit essai qui, je l'espère, vous éclairera sur mon objectif, notamment de balayer, avec la macro, toutes les cellules non vides en plage A3:A13, afin de créer les affiches de toutes les villes.

Cordialement
 

Pièces jointes

  • Affiches.xlsm
    19.1 KB · Affichages: 33
Vote positif 0 Vote négatif
C

Compte Supprimé 979

Guest
Re : Créer un fichier PDF dans le même répertoire.

Re,

Comme dans ta feuille [EXTRACTION] tu as un évènement
Code: 
Private Sub Worksheet_SelectionChange(ByVal Target As Range)

il faut faire la sélection de la cellule, voici le code
VB: 
Sub PDF()
  Dim Cel As Range
  For Each Cel In Sheets("EXTRACTION").Range("A3:A13")
    ' Tester
   If Cel.Value <> "" Then
     ' Faire la sélection pour le changement
      Cel.Select
      ' Exporter au format PDF
      ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=ThisWorkbook.Path & "\" & Cel.Value & ".pdf", _
                                      Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
    Else
      MsgBox "Les fichiers pdf ont été édités avec succès dans le dossier suivant : " & ThisWorkbook.Path
      Exit Sub
    End If
  Next Cel
End Sub

A+
 
Vote positif 0 Vote négatif
W

webmuster

XLDnaute Junior
Re : Créer un fichier PDF dans le même répertoire.

Merci BrunoM45

Ton code fonctionne à merveille.
Grâce à toi, je vais pouvoir partager un outil pratique, léger et fiable.

Bonne soirée à toi et à tous les altruistes de ce forum.

Bien cordialement
 
Vote positif 0 Vote négatif

Discussions similaires

S
  • Question
XL 2016 Erreur dans fonction VBA
Réponses
2
Affichages
289
sylvanu
sylvanu
M
  • Résolu(e)
XL 2013 VBA enregistrement fichier dans un dossier en particulier
Réponses
3
Affichages
197
MarineU
M
N
  • Question
XL 2016 Code VBA pour envoi de mail avec pdf en piece jointe
Réponses
4
Affichages
203
Phil69970
Phil69970
C
  • Résolu(e)
XL 2021 Ne pas enregistrer la 2 ème feuille dans le pdf
Réponses
1
Affichages
284
Claudinedu13
C
J
  • Résolu(e)
XL 2021 pb d'export pdf
Réponses
3
Affichages
646
JPaul78
J
P
  • Question
XL 2019 Changer nom d'export en VBA
Réponses
3
Affichages
407
job75
job75
G
  • Question
Microsoft 365 vba intégrer réf onglet dans code sauvegarde
Réponses
2
Affichages
446
patricktoulon
patricktoulon
P
  • Résolu(e)
XL 2010 Enregistrer sous un seul PDF toutes les feuilles visibles d'un classeur
Réponses
3
Affichages
602
Panda79360
P
N
  • Question
Autres bouton d'action sous excel
Réponses
6
Affichages
230
wDog66
wDog66
J
  • Résolu(e)
XL 2021 plantage lors d'un export format PDF
Réponses
14
Affichages
678
JPaul78
J

Membres actuellement en ligne

18 membres et 320 invités.

Partager cette page

Tutos vidéos

Power Query : Ajouter des requêtes (Excel et Power BI)
Créez votre première fonction LAMBDA dans Excel en 3 étapes!
LAMBDA, l’arme secrète de Microsoft pour Excel !
Office Insider - Découvrez les nouveautés Excel avant tout le monde

Statistiques des forums

Discussions
314 422
Messages
2 109 447
Membres
110 482
dernier inscrit
ilyxxxh