Eh bien ouvrez le classeur 2, exportez sa feuille 1 en PDF et refermez-le.En fin de journée le classeur 1 est cloturé avec un export en pdf dans un fichier précis. Lors de cette cloture j'aimerai que le classeur 2 (feuille 1) soit exportée automatiquement dans un fichier bien précis.
'--------------------------------------------------------------------
'Créer le fichier PDF correspondant à la feuille du classeur demandé.
'- WBFullPath: Chemin complet du classeur (y compris lettre du Drive)
'- NuméroFeuille: n° de la feuille concernée
'- Return: Chemin complet du fichier PDF créé
'
'Exemple d'appel:
' Dim FullPathFichierPDF as string
' 'Exporte en PDF la 1ère feuille du classeur
' FullPathFichierPDF = ExporterFeuilleEnPDF("H:\Téléchargements\Inspection aire de mouvement.xlsm")
' MsgBox "Fichier PDF <" & FullPathFichierPDF & "> créé !"
'--------------------------------------------------------------------
Public Function ExporterFeuilleEnPDF(WBFullPath As String, Optional NuméroFeuille As Integer = 1) As String
Dim WB As Workbook
Dim WS As Worksheet
Dim PDFFullPath As String
Const FormatTimeStamp As String = "yyyy-mm-dd-hh\hnn" 'Mettre à chaine vide si le nom du fichier ne doit pas contenir Date & Heure
'Inhibe l'affichage
Application.ScreenUpdating = False
'Gestion erreur ON
On Error GoTo Erreur
'Ouvre le classeur
Set WB = Workbooks.Open(WBFullPath)
'Sélectionne la feuille demandée
Set WS = WB.Worksheets(NuméroFeuille)
WS.Select
'Time Stamp
If Len(FormatTimeStamp) > 0 Then
PDFFullPath = "-" & Format(Now, FormatTimeStamp)
Else
PDFFullPath = ""
End If
'Nom du fichier PDF
PDFFullPath = WB.Path & "\" & ActiveSheet.Name & PDFFullPath & ".pdf"
'Suppression si existe
If Len(Dir(PDFFullPath)) > 0 Then Kill PDFFullPath
'Export de la feuille en PDF
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=PDFFullPath, _
Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
'Ferme le classeur
WB.Close savechanges:=False
GoTo FinSub
Erreur:
MsgBox "Erreur #" & Err.Number & " " & Err.Description & vbCrLf & "Source: " & Err.Source
PDFFullPath = ""
FinSub:
On Error GoTo 0
'Désinhibe l'affichage
Application.ScreenUpdating = True
'Return value
ExporterFeuilleEnPDF = PDFFullPath
End Function
Dim Retour as string
Retour = ExporterFeuilleEnPDF("H:\Téléchargements\Inspection aire de mouvement.xlsm", _
"C:\Users\F Leroy\Desktop\Documents enregistrés\FicAireMvt.pdf")
MsgBox Retour
-------------------------------------------------------------------------
'Créer le fichier PDF correspondant à la feuille du classeur demandé.
'- WBFullPath: Chemin complet du classeur (y compris lettre du Drive)
'- PDFFullPath: Chemin complet du fichier PDF à créer
'- Return: Résultat de la fonction:
' - "Fichier créé"
' - "Cellule date vide"
' - "Erreur..."
'
'Exemple d'appel:
' Dim Retour as string
' Retour = ExporterFeuilleEnPDF("H:\Téléchargements\Inspection aire de mouvement.xlsm", "C:\Documents\Monfichier.pdf")
' MsgBox Retour
'-------------------------------------------------------------------------
Public Function ExporterFeuilleEnPDF(WBFullPath As String, _
PDFFullPath As String) As String
Dim WB As Workbook
Dim WS As Worksheet
Dim Retour As String
Const CelluleDate = "C4"
'Inhibe l'affichage
Application.ScreenUpdating = False
'Gestion erreur ON
On Error GoTo Erreur
'Ouvre le classeur
Set WB = Workbooks.Open(WBFullPath)
'Sélectionne la feuille demandée
Set WS = WB.Worksheets(1)
WS.Select
'Exporter en PDF si la cellule date est valoriése
If Not IsEmpty(WS.Range(CelluleDate)) Then
'Suppression si existe
If Len(Dir(PDFFullPath)) > 0 Then Kill PDFFullPath
'Export de la feuille en PDF
WS.ExportAsFixedFormat Type:=xlTypePDF, Filename:=PDFFullPath, _
Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
'Valeur de retour
Retour = "Fichier créé"
Else
'Valeur de retour
Retour = "Cellule date vide"
End If
'Ferme le classeur
WB.Close savechanges:=False
GoTo FinSub
Erreur:
'Valeur de retour
Retour = "Erreur #" & Err.Number & " " & Err.Description & vbCrLf & "Source: " & Err.Source
FinSub:
On Error GoTo 0
'Désinhibe l'affichage
Application.ScreenUpdating = True
'Valeur de retour
ExporterFeuilleEnPDF = Retour
End Function