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

C
  • Résolu(e)
XL 2021 Ne pas enregistrer la 2 ème feuille dans le pdf
Réponses
1
Affichages
150
Claudinedu13
C
G
  • Question
Microsoft 365 vba intégrer réf onglet dans code sauvegarde
Réponses
2
Affichages
259
patricktoulon
patricktoulon
P
  • Résolu(e)
XL 2010 Enregistrer sous un seul PDF toutes les feuilles visibles d'un classeur
Réponses
3
Affichages
229
Panda79360
P
J
  • Résolu(e)
XL 2021 plantage lors d'un export format PDF
Réponses
14
Affichages
252
JPaul78
J
spherestyle
  • Résolu(e)
XL pour MAC Excel vba export pdf sur bureau pour Mac
Réponses
10
Affichages
480
Dan
Dan
P
  • Résolu(e)
Microsoft 365 creer un dossier et sauvergarder un fichier PDF avec le meme nom
Réponses
5
Affichages
316
Lolote83
L
M
  • Question
Microsoft 365 pb enregistrement PDF de plusieurs feuilles d'un classeur excel
2
Réponses
15
Affichages
1 K
MG_000
M
S
  • Question
XL 2019 vba sauvegarde pdf noms variables
2
Réponses
25
Affichages
707
sofmat
S
L
  • Question
Autres [ RESOLU ] Impression PDF via VBA
Réponses
5
Affichages
498
lechti31
L
V
  • Résolu(e)
XL 2016 Exportation au format PDF à l'aide d'une macro : erreur 1004 'Document non enregistré'
Réponses
14
Affichages
519
Phil69970
Phil69970

Membres actuellement en ligne

18 membres et 95 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
312 207
Messages
2 086 240
Membres
103 162
dernier inscrit
fcfg