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

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
 
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+
 

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:

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
 

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
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+
 

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
 

Discussions similaires

Réponses
3
Affichages
646

Statistiques des forums

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