Exportasfixedformat PDF jointure autre PDF
Bonjour,
J'ai une macro me permettant de sauvegarder une feuille excel sous format PDF avec un nom bien précis, dans un dossier bien précis et en faisant des backup.
En general le fichier sauvé est une facture. J'aimerais pouvoir joindre automatiquement les conditions générales au fichier initiallement sauvé au format PDF. Donc en gros il s'agit de sauvegarder sous format au PDF puis d'y joindre à un autre PDF. J'aimerais éviter de copier les conditions générales dans une feuille excel sous format jpg par soucis d'efficacité.
Pour ceux que ça intéresse, je copie ma macro permettant de sauvegarder les fichiers sous format pdf et xlsm dans multiples dossier, sous un nom bien précis et en incrémentant les noms de fichier de 1 pour permettre le backup.
Merci pour vos pistes d'orientation ;)
Code:
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91
| Public Declare PtrSafe Function SHCreateDirectoryEx Lib "Shell32.dll" Alias "SHCreateDirectoryExA" _
(ByVal hWnd As Long, ByVal pszPath As String, ByVal lngsec As Long) As Long
Option Explicit
Public Sub CreerDossier(sDossier As String)
SHCreateDirectoryEx 0&, sDossier, 0&
End Sub
Public Function ExistenceFichier(sFichier As String) As Boolean
ExistenceFichier = Dir(sFichier) <> ""
End Function
Sub sauvegarderfichier()
Dim sDossier As String, yDossier As String, sNomFichier As String, xnomfichier As String, ynomfichier As String
Dim sNum As String, i As Integer
If ActiveSheet.Range("A4") = "VRAI" Then
sDossier = ActiveSheet.Range("A21") & "Avec Tri\" & ActiveSheet.Range("E6") & "\"
yDossier = ActiveSheet.Range("A21") & "Sans Tri\"
End If
If ActiveSheet.Range("A5") = "VRAI" Then
sDossier = ActiveSheet.Range("A20") & "Avec Tri\" & ActiveSheet.Range("E6") & "\"
yDossier = ActiveSheet.Range("A20") & "Sans Tri\"
End If
If ActiveSheet.Range("A6") = "VRAI" Then
sDossier = ActiveSheet.Range("A22") & "Avec Tri\" & ActiveSheet.Range("E6") & "\"
yDossier = ActiveSheet.Range("A22") & "Sans Tri\"
End If
If ActiveSheet.Range("A7") = "VRAI" Then
sDossier = ActiveSheet.Range("A23") & "Avec Tri\" & ActiveSheet.Range("E6") & "\"
yDossier = ActiveSheet.Range("A23") & "Sans Tri\"
End If
CreerDossier sDossier
CreerDossier yDossier
sNomFichier = "BBW_" & ActiveSheet.Range("G3") & "_" & ActiveSheet.Range("H5") & "_" & ActiveSheet.Range("E6") & ".pdf"
ynomfichier = "BBW_" & ActiveSheet.Range("G3") & "_" & ActiveSheet.Range("H5") & "_" & ActiveSheet.Range("E6") & ".pdf"
xnomfichier = "BBW_" & ActiveSheet.Range("G3") & "_" & ActiveSheet.Range("H5") & "_" & ActiveSheet.Range("E6") & ".xlsm"
i = 1
If ExistenceFichier(sDossier & xnomfichier) = True Then
Do
Select Case i
Case 1 To 9: sNum = "00" & CStr(i)
Case 10 To 99: sNum = "0" & CStr(i)
Case Else: sNum = CStr(i)
End Select
xnomfichier = "BBW_" & ActiveSheet.Range("G3") & "_" & ActiveSheet.Range("H5") & "_" & ActiveSheet.Range("E6") & "_" & sNum & ".xlsm"
i = i + 1
Loop Until ExistenceFichier(sDossier & xnomfichier) = False
End If
If ExistenceFichier(sDossier & sNomFichier) = True Then
Do
Select Case i
Case 1 To 9: sNum = "00" & CStr(i)
Case 10 To 99: sNum = "0" & CStr(i)
Case Else: sNum = CStr(i)
End Select
sNomFichier = "BBW_" & ActiveSheet.Range("G3") & "_" & ActiveSheet.Range("H5") & "_" & ActiveSheet.Range("E6") & "_" & sNum & ".pdf"
i = i + 1
Loop Until ExistenceFichier(sDossier & sNomFichier) = False
End If
If ExistenceFichier(yDossier & ynomfichier) = True Then
ynomfichier = "BBW_" & ActiveSheet.Range("G3") & "_" & ActiveSheet.Range("H5") & "_" & ActiveSheet.Range("E6") & ".pdf"
End If
ActiveWorkbook.SaveAs Filename:=sDossier & xnomfichier, _
FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
Sheets("DOCUMENT").ExportAsFixedFormat Type:=xlTypePDF, Filename:=sDossier & sNomFichier, _
QUALITY:=xlQualityStandard, IncludeDocProperties:=False, IgnorePrintAreas _
:=True, OpenAfterPublish:=False
Sheets("DOCUMENT").ExportAsFixedFormat Type:=xlTypePDF, Filename:=yDossier & ynomfichier, _
QUALITY:=xlQualityStandard, IncludeDocProperties:=False, IgnorePrintAreas _
:=True, OpenAfterPublish:=False
End Sub |