Sauvegarder fichier au format excel et pdf en même temps

RONIBO

XLDnaute Impliqué
Bonjour,

Je souhaite sauvegarder mes devis ou factures aux formats Excel (XLSM) puis PDF en même temps.

Actuellement j'enregistre mes fichiers Excel dans des dossiers "Devis et "Facture", à l'intérieur de ses dossiers j'ai rajouté un autre dossier "Devis (Format PDF)" ou "Facture (Format PDF)".

J'utilise ce code pour automatiser la sauvegarde de mes devis ou facture.

Code:
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Dim Chemin As String, MyFile As String
Range("F1:G1").Select
SaveAsUI = False
Cancel = True
With Worksheets(NomFeuille)
Select Case Left(.Range("F10"), 1)
Case "D": Chemin = CheminDossierDevis
Case "F": Chemin = CheminDossierFacture
End Select
If Dir(Chemin, vbDirectory) = "" Then
MsgBox "Le répertoire devis ou facture n'existe pas !" & Chr(10) & "Le document sera enregistré sur le bureau de votre ordinateur", vbInformation, "Répertoire inexistant"
Chemin = "C:\Users\" & Application.UserName & "\Desktop\"
End If
MyFile = Chemin & .Range("F10") & .Range("G10").Text & Chr(160) & "-" & Chr(160) & .Range("A12") & Chr(160) & "(" & .Range("F14") & ")" & ".xlsm"
End With
If Dir(MyFile) <> "" Then
If MsgBox("Un document nommé '" & MyFile & "' existe déjà à cet emplacement." & Chr(10) & Chr(10) & "Voulez-vous la remplacer ?", vbQuestion + vbYesNo + vbDefaultButton2, "Devis ou facture déjà existant") <> vbYes Then
MsgBox "Le document n'a pas été enregistré !", vbInformation, "Opération annulée"
Exit Sub
End If
End If
Application.EnableEvents = False
Application.DisplayAlerts = False
Me.SaveAs MyFile
Application.DisplayAlerts = False
Application.EnableEvents = True
MsgBox "Le document a bien été enregistré !", vbInformation, "Confirmation"
MsgBox "Voulez-vous créer un nouveau devis ou une nouvelle facture ?", vbYesNo + vbQuestion, "Nouveau document"
End Sub

Merci d'avance.

Je joint un fichier exemple à extraire dans c: svp

Bonne soirée
 

Pièces jointes

  • Ronibo.zip
    19.2 KB · Affichages: 47
  • Ronibo.zip
    19.2 KB · Affichages: 73
  • Ronibo.zip
    19.2 KB · Affichages: 39

grisan29

XLDnaute Accro
Re : Sauvegarder fichier au format excel et pdf en même temps

bonjour Ronibo

si tu as mon classeur tu pourrai y trouvé l'amélioration de ceci
Code:
Private Sub NewFeuille_Click()

  Dim sPath As String
  Dim NomFicXL As String, CheminXL As String
  Dim NomFicPDF As String, CheminPDF As String
  Dim Client As String
  Dim Plage As Range
  Dim DLig As Long
  Dim Shp As Shape
  Dim Sht As Worksheet
  ' Initialiser les variables nécessaires au code
  ' Définir la feuille
  Set Sht = ThisWorkbook.Sheets("Facture")
  ' Définir le chemin de base par défaut
  
  sPath = "C:\sauvegarde\"
  ' Définir le client - Qu'elle cellule ??
  Client = Sht.Range("J5").Value
  '
  DLig = Sht.Range("C65536").End(xlUp).Row
  NomFicXL = Sht.Range("D17").Value & " - " & Sht.Range("J5").Value & ".xls"
  NomFicPDF = Client & ".pdf"
  ' Pour vérification de la valeur
  Select Case UCase(Sht.Range("D1").Value)
  Case "DEVIS"
    CheminXL = "Devis\"
    CheminPDF = "DevisPDF\"
  Case "FACTURE"
    CheminXL = "Facture\"
    CheminPDF = "FacturePDF\"
  Case "FACTURE SAV"
    CheminXL = "Facturesav\"
    CheminPDF = "FacturesavPDF\"
  Case "FACTURE D'ACOMPTE"
    CheminXL = "Factureacompte\"
    CheminPDF = "FactureacomptePDF\"
  Case Else
    MsgBox "Erreur pour trouver le chemin de " & Sht.Range("D1").Value
    Exit Sub
  End Select
  ' Copier la feuille dans un nouveau classeur
  Sht.Copy
  ' Supprimer tous les objets (boutons) de la feuille copiée
  For Each Shp In ActiveWorkbook.ActiveSheet.Shapes
    Shp.Delete
  Next Shp
  ' Sauvegarder le classeur actif dans le chemin et le nom determiné
  ActiveWorkbook.SaveAs Filename:=sPath & CheminXL & NomFicXL, _
                        FileFormat:=xlExcel8, Password:="", WriteResPassword:="", _
                        ReadOnlyRecommended:=False, CreateBackup:=False
  ' Exporter en PDF
  ActiveWorkbook.ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=sPath & CheminPDF & NomFicPDF, Quality:= _
                                                 xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, _
                                                 OpenAfterPublish:=False

  MsgBox "Votre sauvegarde porte la référence : " & " " & NomFicXL & vbCrLf _
       & "Le fichier PDF à été créé sous le nom : " & NomFicPDF
  ' Fermer le classeur actif
  'ActiveWorkbook.Close
  ' Effacer à partir d'ici
  DLig = Sht.Range("C19").End(xlDown)(1).Row
  If DLig > 19 Then
    Set Plage = Sht.Range("C19:B" & Sht.Range("C19").End(xlDown)(1).Row - 3)
    Plage.EntireRow.Delete
  End If
  Sht.Range("J5:J10").Value = ""

  'Sauvegarde les modifications
  ActiveWorkbook.Save
  ActiveWindow.Close
  Select Case UCase(Range("D1"))
  Case Is = "DEVIS"
    Range("B9") = Range("B9") + 1
  Case Is = "FACTURE"
    Range("B10") = Range("B10") + 1
  Case Is = "FACTURE D'ACOMPTE"
    Range("B11") = Range("B11") + 1
  Case Is = "FACTURE SAV"
    Range("B12") = Range("B12") + 1
  End Select

End Sub

bon week end et bonne fêtes de Noël a tous le forum

Pascal
 
Dernière édition:

RONIBO

XLDnaute Impliqué
Re : Sauvegarder fichier au format excel et pdf en même temps

Bonjour,

Merci Pascal :)

J'ai essayé de faire quelque chose, je bloque sur "End With sans With" pourtant "With" est bien dans le code.

Code:
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Dim Chemin As String, CheminPDF As String, MyFile As String
Range("F1:G1").Select
SaveAsUI = False
Cancel = True
With Worksheets(NomFeuille)
Select Case Left(.Range("F10"), 1)

Case "D": Chemin = CheminDossierDevis
Case "F": Chemin = CheminDossierFacture

Case "D": CheminPDF = CheminDossierDevisPDF
Case "F": CheminPDF = CheminDossierFacturePDF

End Select

If Dir(Chemin, vbDirectory) = "" Then
If Dir(CheminPDF, vbDirectory) = "" Then

MsgBox "Le répertoire devis ou facture n'existe pas !" & Chr(10) & "Le document sera enregistré sur le bureau de votre ordinateur", vbInformation, "Répertoire inexistant"
Chemin = "C:\Users\" & Application.UserName & "\Desktop\"
End If

MyFile = Chemin & .Range("F10") & .Range("G10").Text & Chr(160) & "-" & Chr(160) & .Range("A12") & Chr(160) & "(" & .Range("F14") & ")" & ".xlsm"
MyFile = CheminPDF & .Range("F10") & .Range("G10").Text & Chr(160) & "-" & Chr(160) & .Range("A12") & Chr(160) & "(" & .Range("F14") & ")" & ".xlsm"

End With
If Dir(MyFile) <> "" Then
If MsgBox("Un document nommé '" & MyFile & "' existe déjà à cet emplacement." & Chr(10) & Chr(10) & "Voulez-vous la remplacer ?", vbQuestion + vbYesNo + vbDefaultButton2, "Devis ou facture déjà existant") <> vbYes Then
MsgBox "Le document n'a pas été enregistré !", vbInformation, "Opération annulée"
Exit Sub
End If
End If
Application.EnableEvents = False
Application.DisplayAlerts = False
Me.SaveAs MyFile
Application.DisplayAlerts = False
Application.EnableEvents = True

ActiveWorkbook.ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=sPath & CheminPDF & NomFicPDF, Quality:= _
xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, _
OpenAfterPublish:=Fals

MsgBox "Le document a bien été enregistré !", vbInformation, "Confirmation"
Range("G10") = Range("G10") + 1
End Sub

Vous avez une idée?
 

grisan29

XLDnaute Accro
Re : Sauvegarder fichier au format excel et pdf en même temps

bonjour Ronibo

je pense que tu a un "end if " en trop dans cette partie
Code:
MsgBox "Le document n'a pas été enregistré !", vbInformation, "Opération annulée"
Exit Sub
End If
End If
mais je ne suis pas très sûr
edit: Hasco tu a raison le manque d’indentation ne m'a pas montrer le bon "end if" que tu a trouvé

Pascal
 
Dernière édition:

RONIBO

XLDnaute Impliqué
Re : Sauvegarder fichier au format excel et pdf en même temps

Bonjour,

Merci pour vos commentaires :)

J'ai fais se que vous m'avez dit et la je bloque ici :
Me.SaveAs MyFile

Sans titre.png

Voici mon code :

Code:
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Dim Chemin As String, CheminPDF As String, MyFile As String
Range("F1:G1").Select
SaveAsUI = False
Cancel = True
With Worksheets(NomFeuille)
Select Case Left(.Range("F10"), 1)

Case "D": Chemin = CheminDossierDevis
Case "F": Chemin = CheminDossierFacture

Case "D": CheminPDF = CheminDossierDevisPDF
Case "F": CheminPDF = CheminDossierFacturePDF

End Select

If Dir(Chemin, vbDirectory) = "" Then
If Dir(CheminPDF, vbDirectory) = "" Then

MsgBox "Le répertoire devis ou facture n'existe pas !" & Chr(10) & "Le document sera enregistré sur le bureau de votre ordinateur", vbInformation, "Répertoire inexistant"
Chemin = "C:\Users\" & Application.UserName & "\Desktop\"
End If

MyFile = Chemin & .Range("F10") & .Range("G10").Text & Chr(160) & "-" & Chr(160) & .Range("A12") & Chr(160) & "(" & .Range("F14") & ")" & ".xlsm"
MyFile = CheminPDF & .Range("F10") & .Range("G10").Text & Chr(160) & "-" & Chr(160) & .Range("A12") & Chr(160) & "(" & .Range("F14") & ")" & ".xlsm"
End If
End With
If Dir(MyFile) <> "" Then
If MsgBox("Un document nommé '" & MyFile & "' existe déjà à cet emplacement." & Chr(10) & Chr(10) & "Voulez-vous la remplacer ?", vbQuestion + vbYesNo + vbDefaultButton2, "Devis ou facture déjà existant") <> vbYes Then
MsgBox "Le document n'a pas été enregistré !", vbInformation, "Opération annulée"
Exit Sub
End If
End If

Application.EnableEvents = False
Application.DisplayAlerts = False
Me.SaveAs MyFile
Application.DisplayAlerts = False
Application.EnableEvents = True

ActiveWorkbook.ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=sPath & CheminPDF & NomFicPDF, Quality:= _
xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, _
OpenAfterPublish:=Fals

MsgBox "Le document a bien été enregistré !", vbInformation, "Confirmation"
Range("G10") = Range("G10") + 1
End Sub

vous avez une idée?
 

Pièces jointes

  • Sans titre.png
    Sans titre.png
    5.5 KB · Affichages: 63
  • Sans titre.png
    Sans titre.png
    5.5 KB · Affichages: 62

grisan29

XLDnaute Accro
Re : Sauvegarder fichier au format excel et pdf en même temps

Bonjour Ronibo

tu a très peu modifié ton code !! essaie comme ceci pour voir
Code:
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Dim Chemin As String, CheminPDF As String, MyFile As String
Range("F1:G1").Select
SaveAsUI = False
Cancel = True
With Worksheets(NomFeuille)
    Select Case Left(.Range("F10"), 1)

    Case "D": Chemin = CheminDossierDevis
    Case "F": Chemin = CheminDossierFacture

    Case "D": CheminPDF = CheminDossierDevisPDF
    Case "F": CheminPDF = CheminDossierFacturePDF

  End Select

     If Dir(Chemin, vbDirectory) = "" Then
    End If
     If Dir(CheminPDF, vbDirectory) = "" Then
                   MsgBox "Le répertoire devis ou facture n'existe pas !" & Chr(10) & "Le document sera enregistré sur le bureau de votre ordinateur", vbInformation, "Répertoire inexistant"
     End If
            Chemin = "C:\Users\" & Application.UserName & "\Desktop\"

   MyFile = Chemin & .Range("F10") & .Range("G10").Text & Chr(160) & "-" & Chr(160) & .Range("A12") & Chr(160) & "(" & .Range("F14") & ")" & ".xlsm"
   MyFile = CheminPDF & .Range("F10") & .Range("G10").Text & Chr(160) & "-" & Chr(160) & .Range("A12") & Chr(160) & "(" & .Range("F14") & ")" & ".xlsm"


If Dir(MyFile) <> "" Then
    MsgBox("Un document nommé '" & MyFile & "' existe déjà à cet emplacement." & Chr(10) & Chr(10) & "Voulez-vous la remplacer ?", vbQuestion + vbYesNo + vbDefaultButton2, "Devis ou facture déjà existant") <> vbYes Then
    MsgBox "Le document n'a pas été enregistré !", vbInformation, "Opération annulée"
  Exit Sub
End If


Application.EnableEvents = False
Application.DisplayAlerts = False
Me.SaveAs MyFile
Application.DisplayAlerts = False
Application.EnableEvents = True

ActiveWorkbook.ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=sPath & CheminPDF & NomFicPDF, Quality:= _
xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, _
OpenAfterPublish:=Fals

MsgBox "Le document a bien été enregistré !", vbInformation, "Confirmation"
   .Range("G10") = Range("G10") + 1
End With

End Sub

Pascal
 

RONIBO

XLDnaute Impliqué
Re : Sauvegarder fichier au format excel et pdf en même temps

Bonjour,

Je vous souhaite à toutes et à tous un joyeux noël. Que cette journée soit remplie de joie et de bonheur ! :)

Revenons à mon problème.

J'ai pu tester les deux codes, elle fonctionne parfaitement.

J'aurais deux petites questions à mapomme :

A quoi sert cette ligne :

Application.EnableEvents = True

Puis sur cette ligne, Est-ce que on peux mettre que le non du fichier, et supprimer le chemin?

If MsgBox("Le document suivant existe déjà :" & Chr(10) & Chr(10) & """" & MyFile & """" & Chr(10) & Chr(10) & "Voulez-vous le remplacer ?", vbQuestion + vbYesNo + vbDefaultButton2, "Devis ou facture déjà existant") <> vbYes Then

Bonne journée
 

grisan29

XLDnaute Accro
Re : Sauvegarder fichier au format excel et pdf en même temps

bonjour Ronibo
voila ce que j'ai trouvé dans l'aide vba pour
Code:
Application.EnableEvents
Code:
Référence du développeur Excel 
Application.EnableEvents, propriété 
Cette propriété a la valeur True si des événements sont activés pour l'objet spécifié. Type de données Boolean en lecture-écriture.
Syntaxe

expression.EnableEvents

expression   Variable qui représente un objet Application.

Exemple

Pascal
Cet exemple montre comment désactiver des événements avant l'enregistrement d'un fichier de telle sorte que l'événement BeforeSave n'ait pas lieu.

Visual Basic pour Applications 
Application.EnableEvents = False
ActiveWorkbook.Save
Application.EnableEvents = True
 

Discussions similaires