Exporter un PDF à deux endroits différents

**sweetty** · 04/06/2025, 13h43

Bonjour,
Lors de la création d'une facture, à son enregistrement, je l'exporte en pdf sur une clé USB. Jusque là, ça marche nickel.

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
'Enregistrement sur clé USB
 
    'Déclaration des variables
    Dim NomDossier As String
    Dim CheminDossier As String
 
    On Error GoTo 1
 
    'Nom de dossier
     NomDossier = Application.InputBox("Dossier Enregistrement :", "Dossier")
    CheminDossier = "H:\COMPTABILITE\Factures VE\" & NomDossier & "\"
 
 
    If NomDossier = "" Then Exit Sub
 
    'Enregistrement au format PDF
    ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
    CheminDossier & "Facture_" & Range("J1").Value & ".pdf", quality:= _
    xlQualityStandard, includedocproperties:=True, ignoreprintareas:=False, _
    from:=1, To:=1, openafterpublish:=False
 
1

Le hic, c'est que j'aimerai l'enregistrer sur deux supports différents, une copie sur ma clé et la deuxième sur mon pc.
J'ai essayé pas mal de chose, mais au final soit mon PDF ne s'enregistre que sur un support, soit à la validation, hormis le PDF, ma facture s'enregistre deux fois en comptabilité, c'est pas top

Peut être que je devrais créer un macro juste pour l'export de pdf?

Voici le code de la macro au complet, pour donner une idée du contenu:

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
Sub VALIDER()
 
 
      Dim Titres(), Dic As New Dictionary, c As Long, TFact(), L As Long, TRés(), item
    Titres = Feuil4.[A2:BV2].Value    'fait correspondre entêtes de VE avec produits Feuil2
    TFact = Feuil1.[A12:J44].Value
 
    ReDim TRés(1 To 1, 1 To UBound(Titres, 2))
    TRés(1, 1) = TFact(1, 4)    'n° de facture
    TRés(1, 2) = TFact(1, 1)    'date
    TRés(1, 3) = TFact(1, 5)    ' N° client
    TRés(1, 4) = NomClient(TFact(1, 5))    ' Nom client
    TRés(1, 5) = TFact(31, 10)    ' TTC
    TRés(1, 6) = TFact(29, 10)    'HT
    TRés(1, 7) = TFact(30, 5)    'TVA 5.5%
    TRés(1, 8) = TFact(31, 5)    'TVA 7%
    TRés(1, 9) = TFact(32, 5)    'TVA 10%
    TRés(1, 10) = TFact(33, 5)    'TVA 20%
    'TRés(1, 93) = TFact(2, 4)    'nombre de page de facture
 
    For c = 11 To 73   'produits ligne 2 VE
        For L = 4 To 27    'lignes 15 to 38 de factures
            If TFact(L, 2) = Titres(1, c) Then
                TRés(1, c) = TRés(1, c) + TFact(L, 10)
            End If
        Next
    Next c
 
    Feuil4.Cells(&H100000, 1).End(xlUp).Offset(1).Resize(, 73).Value = TRés
 
'Enregistrement sur clé USB
 
    'Déclaration des variables
    Dim NomDossier As String
    Dim CheminDossier As String
 
    On Error GoTo 1
 
    'Nom de dossier
     NomDossier = Application.InputBox("Dossier Enregistrement :", "Dossier")
    CheminDossier = "H:\COMPTABILITE\Factures VE\" & NomDossier & "\"
 
 
    If NomDossier = "" Then Exit Sub
 
    'Enregistrement au format PDF
    ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
    CheminDossier & "Facture_" & Range("J1").Value & ".pdf", quality:= _
    xlQualityStandard, includedocproperties:=True, ignoreprintareas:=False, _
    from:=1, To:=1, openafterpublish:=False
 
1
 
 
 
    MsgBox "Facture " & Range("J1").Value & " archivée avec succès."
 
 
    Dim n
 
    n = Right(Range("J1").Value, 5)
 
    'On incrémente le numéro de la facture
    Range("J1").Value = Range("J1").Value + 1
 
    'on efface le contenu de la facture
 
    Range("A15:E39,G15:G39,J43").ClearContents
    Range("J38").Select
    Selection.AutoFill Destination:=Range("J15:J38"), Type:=xlFillDefault
    Range("J15:J38").Select
 
    Range("H6").Select
 
 
End Sub

Merci pour votre aide

**Nain porte koi** · 04/06/2025, 14h59

Hello,

ceci devrait répondre à votre besoin

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
Sub VALIDER()
 
 
      Dim Titres(), Dic As New Dictionary, c As Long, TFact(), L As Long, TRés(), item
    Titres = Feuil4.[A2:BV2].Value    'fait correspondre entêtes de VE avec produits Feuil2
    TFact = Feuil1.[A12:J44].Value
 
    ReDim TRés(1 To 1, 1 To UBound(Titres, 2))
    TRés(1, 1) = TFact(1, 4)    'n° de facture
    TRés(1, 2) = TFact(1, 1)    'date
    TRés(1, 3) = TFact(1, 5)    ' N° client
    TRés(1, 4) = NomClient(TFact(1, 5))    ' Nom client
    TRés(1, 5) = TFact(31, 10)    ' TTC
    TRés(1, 6) = TFact(29, 10)    'HT
    TRés(1, 7) = TFact(30, 5)    'TVA 5.5%
    TRés(1, 8) = TFact(31, 5)    'TVA 7%
    TRés(1, 9) = TFact(32, 5)    'TVA 10%
    TRés(1, 10) = TFact(33, 5)    'TVA 20%
    'TRés(1, 93) = TFact(2, 4)    'nombre de page de facture
 
    For c = 11 To 73   'produits ligne 2 VE
        For L = 4 To 27    'lignes 15 to 38 de factures
            If TFact(L, 2) = Titres(1, c) Then
                TRés(1, c) = TRés(1, c) + TFact(L, 10)
            End If
        Next
    Next c
 
    Feuil4.Cells(&H100000, 1).End(xlUp).Offset(1).Resize(, 73).Value = TRés
 
'Enregistrement sur clé USB et sur disque dur
 
    'Déclaration des variables
    Dim NomDossier As String
    Dim CheminDossier As String
 
    On Error GoTo 1
 
    'Nom de dossier
    NomDossier = Application.InputBox("Dossier Enregistrement sur clé USB :", "Dossier")
    If NomDossier = "" Then Exit Sub
 
    CheminDossier = "H:\COMPTABILITE\Factures VE\" & NomDossier & "\"
 
    'Enregistrement au format PDF
    ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
    CheminDossier & "Facture_" & Range("J1").Value & ".pdf", quality:= _
    xlQualityStandard, includedocproperties:=True, ignoreprintareas:=False, _
    from:=1, To:=1, openafterpublish:=False
 
    NomDossier = Application.InputBox("Dossier Enregistrement sur disque dur du PC :", "Dossier")
    If NomDossier = "" Then Exit Sub
 
' *************************************************************************
    ' adater le chemin sur le disque dur
    CheminDossier = "H:\COMPTABILITE\Factures VE\" & NomDossier & "\"
' *************************************************************************
 
    'Enregistrement au format PDF
    ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
    CheminDossier & "Facture_" & Range("J1").Value & ".pdf", quality:= _
    xlQualityStandard, includedocproperties:=True, ignoreprintareas:=False, _
    from:=1, To:=1, openafterpublish:=False
 
 
1
 
 
 
    MsgBox "Facture " & Range("J1").Value & " archivée avec succès."
 
 
    Dim n
 
    n = Right(Range("J1").Value, 5)
 
    'On incrémente le numéro de la facture
    Range("J1").Value = Range("J1").Value + 1
 
    'on efface le contenu de la facture
 
    Range("A15:E39,G15:G39,J43").ClearContents
    Range("J38").Select
    Selection.AutoFill Destination:=Range("J15:J38"), Type:=xlFillDefault
    Range("J15:J38").Select
 
    Range("H6").Select
 
 
End Sub

**sweetty** · 04/06/2025, 15h27

Merci merci

Ca marche nikel

**deedolith** · 04/06/2025, 15h41

Hello,

Plutôt que d'exporter ta feuille 2 fois, pourquoi ne fais tu pas une simple copie de fichier ?

PS:
Il sera plus sage d'exporter en 1er sur le disque dur, et ensuite faire une copie sur la clef USB (si elle est présente).
Les clefs USB étant par nature volatile et plus fragile que les disques dur.

**Nain porte koi** · 04/06/2025, 15h55

@deedolith tu as parfaitement raison

voici une version modifié du code pour enregistrer sur DD puis copier ce fichier sur clé USB, il faut juste adapter le chemin sur le DD

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
Sub VALIDER()
 
 
      Dim Titres(), Dic As New Dictionary, c As Long, TFact(), L As Long, TRés(), item
    Titres = Feuil4.[A2:BV2].Value    'fait correspondre entêtes de VE avec produits Feuil2
    TFact = Feuil1.[A12:J44].Value
 
    ReDim TRés(1 To 1, 1 To UBound(Titres, 2))
    TRés(1, 1) = TFact(1, 4)    'n° de facture
    TRés(1, 2) = TFact(1, 1)    'date
    TRés(1, 3) = TFact(1, 5)    ' N° client
    TRés(1, 4) = NomClient(TFact(1, 5))    ' Nom client
    TRés(1, 5) = TFact(31, 10)    ' TTC
    TRés(1, 6) = TFact(29, 10)    'HT
    TRés(1, 7) = TFact(30, 5)    'TVA 5.5%
    TRés(1, 8) = TFact(31, 5)    'TVA 7%
    TRés(1, 9) = TFact(32, 5)    'TVA 10%
    TRés(1, 10) = TFact(33, 5)    'TVA 20%
    'TRés(1, 93) = TFact(2, 4)    'nombre de page de facture
 
    For c = 11 To 73   'produits ligne 2 VE
        For L = 4 To 27    'lignes 15 to 38 de factures
            If TFact(L, 2) = Titres(1, c) Then
                TRés(1, c) = TRés(1, c) + TFact(L, 10)
            End If
        Next
    Next c
 
    Feuil4.Cells(&H100000, 1).End(xlUp).Offset(1).Resize(, 73).Value = TRés
 
'Enregistrement sur clé USB et sur disque dur
 
    'Déclaration des variables
    Dim NomDossierDD As String
    Dim CheminDossier As String
 
    Dim CheminDossier_DD As String
 
    On Error GoTo 1
 
    'Nom de dossier
    NomDossier = Application.InputBox("Dossier Enregistrement sur disque dur du PC :", "Dossier")
    If NomDossier = "" Then Exit Sub
 
' *************************************************************************
    ' adapter le chemin sur le disque dur
    CheminDossier_DD = "H:\COMPTABILITE\Factures VE\" & NomDossier & "\Facture_" & Range("J1").Value & ".pdf"
' *************************************************************************
 
    'Enregistrement au format PDF
    ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
    CheminDossier, quality:= _
    xlQualityStandard, includedocproperties:=True, ignoreprintareas:=False, _
    from:=1, To:=1, openafterpublish:=False
 
    NomDossier = Application.InputBox("Dossier Enregistrement sur clé USB :", "Dossier")
    If NomDossier = "" Then Exit Sub
 
    CheminDossier = "H:\COMPTABILITE\Factures VE\" & NomDossier & "\Facture_" & Range("J1").Value & ".pdf"
 
    FileCopy CheminDossier_DD, CheminDossier
 
 
1
 
 
 
    MsgBox "Facture " & Range("J1").Value & " archivée avec succès."
 
 
    Dim n
 
    n = Right(Range("J1").Value, 5)
 
    'On incrémente le numéro de la facture
    Range("J1").Value = Range("J1").Value + 1
 
    'on efface le contenu de la facture
 
    Range("A15:E39,G15:G39,J43").ClearContents
    Range("J38").Select
    Selection.AutoFill Destination:=Range("J15:J38"), Type:=xlFillDefault
    Range("J15:J38").Select
 
    Range("H6").Select
 
 
End Sub

(non testé)

Exporter un PDF à deux endroits différents [XL-2019]

Macros et VBA Excel

Vue hybride

Discussions similaires

Partager

Partager