Discussion :

[Jertom]

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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

[alrea]

Bonjour,

Je cherche à développer une fonction similaire. As-tu trouvé une sollution?

Adrien.