Enregistrer 2 formats en même temps

**dav2204** · 07/04/2021, 21h40

Salut la communauté,

Je souhaite pouvoir enregistrer un document sur mon bureau sous format Word et PDF en même temps. un double enregistrement en fait.
Sur la macro ci-dessous, cela fonctionne nickel mais seulement si le document est nouveau.
Pensez vous que cela est possible avec un document portant déjà un nom?

Merci d'avance

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
Sub sauvegarde_2_endroits()
 
Dim strFichierA, strFichierB, strFichierC, strFichierD
ActiveDocument.SAVE
strFichierA = ActiveDocument.Name
'trouve la position de l'extension
intPos = InStrRev(strFichierA, ".")
'remplace l'extension doc par pdf
strFichierA = Left(strFichierA, intPos - 1)
strFichierA = ActiveDocument.FullName & ".PDF"
 
strFichierB = "Bureau" & strFichierA
strFichierC = ActiveDocument.FullName
ActiveDocument.SaveAs FileName:=strFichierB, FileFormat:=wdFormatPDF
ActiveDocument.SaveAs FileName:=strFichierC
End Sub

Invité · 08/04/2021, 05h01

Envoyé par dav2204

Bonjour,

S'il s'agit de générer des fichiers pdf, vous pouvez utiliser la méthode ExportAsFixedFormat :

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
 
Sub TestSauvegardeEnPdf()
 
    SauvegardeEnPdf ActiveDocument, Split(ActiveDocument.Name, ".")(0)
 
End Sub
 
 
Sub SauvegardeEnPdf(ByVal oDoc As Document, ByVal NomDuFichieroDoc As String)
 
Dim NomA As String, NomB As String
 
    With oDoc
         NomA = .Path & "\" & NomDuFichieroDoc & ".pdf"
         NomB = .Path & "\Bureau " & NomDuFichieroDoc & ".pdf"
        .ExportAsFixedFormat OutputFileName:=NomA, ExportFormat:=wdExportFormatPDF, OpenAfterExport:=False
        .ExportAsFixedFormat OutputFileName:=NomB, ExportFormat:=wdExportFormatPDF, OpenAfterExport:=False
    End With
 
End Sub

**dav2204** · 08/04/2021, 20h18

Merci pour votre proposition mais c’’est pas exactement ça.
Il faut que je puisse «*enregistrer sous*» en format word + une copie PDF en une seule fois. Si possible en partant d’un document portant déjà un nom

Invité · 09/04/2021, 05h01

Envoyé par dav2204

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
 
Sub TestSauvegardeEnPdf()
 
    With ActiveDocument
         SauvegardeEnPdf .Name, .Path, .Path & "\Copie " & .Name
    End With
 
End Sub
 
 
Sub SauvegardeEnPdf(ByVal NomDuFichierDoc As String, ByVal RepertoirePdf As String, CheminCompletCopie As String)
 
Dim DocEnCours As Document
Dim NomA As String
Dim Fso As Object
 
    Set DocEnCours = Documents(NomDuFichierDoc)
 
    With DocEnCours
         NomA = RepertoirePdf & "\" & Split(NomDuFichierDoc, ".")(0) & ".pdf"
        .ExportAsFixedFormat OutputFileName:=NomA, ExportFormat:=wdExportFormatPDF, OpenAfterExport:=False
    End With
 
    Set Fso = CreateObject("Scripting.FileSystemObject")
    Fso.CopyFile DocEnCours.FullName, CheminCompletCopie, True
    Set Fso = Nothing
 
    Set DocEnCours = Nothing
 
End Sub

**dav2204** · 10/04/2021, 16h00

Ça ne marche pas chez moi. J’ai une copie qui s’enregistre sur le bureau alors que je souhaite renommer le fichier, et j’ai pas de fichier PDF

Invité · 10/04/2021, 16h27

Envoyé par dav2204

La solution fournie en #4, exporte le contenu du fichier Word en cours en .pdf dans le même répertoire, et crée un autre document Word toujours dans le même répertoire. Cet autre document ie est sauvegardé sous la forme "Copie " + nom du fichier en cours.

**dav2204** · 10/04/2021, 21h11

Et c’est pas possible de pouvoir renommer sa copie comme un «*enregistrer sous*» ?

Invité · 11/04/2021, 05h24

Envoyé par dav2204

Qu'est ce qui ne va pas dans la solution proposée ?

**dav2204** · 11/04/2021, 12h46

Je voudrais pouvoir renommer et choisir l’emplacement de ma copie + PDF

Invité · 11/04/2021, 14h28

Envoyé par dav2204

Il faut passer par un objet FileDialog :

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
 
Sub TestSauvegardeEnPdf()
 
Dim Fd As FileDialog
Dim vrtSelectedItem As Variant
Dim RepertoireChoisi As String
 
    RepertoireChoisi = ""
    Set Fd = Application.FileDialog(msoFileDialogFolderPicker)
    With Fd
         If .Show = -1 Then
            For Each vrtSelectedItem In .SelectedItems
                RepertoireChoisi = vrtSelectedItem
            Next vrtSelectedItem
         End If
    End With
 
    'Debug.Print "Répertoire choisi : " & RepertoireChoisi
 
    If RepertoireChoisi <> "" Then
 
       With ActiveDocument
            'SauvegardeEnPdf .Name, .Path, .Path & "\Copie " & .Name
            SauvegardeEnPdf .Name, RepertoireChoisi, RepertoireChoisi & "\" & .Name
       End With
 
    End If
 
    Set Fd = Nothing
 
End Sub

**dav2204** · 11/04/2021, 19h19

J'arrive pas a utiliser cette dernière proposition désolé.
Que dois je ajouter ?
Merci encore

Invité · 11/04/2021, 19h35

Envoyé par dav2204

Un exemple dans le fichier joint. Cliquer sur le bouton rouge dans la barre d'accès rapide pour lancer la macro.

**dav2204** · 11/04/2021, 21h43

merci pour le fichier.
Il fonctionne.
Quand je clique sur le bouton on me propose de choisir un emplacement mais par contre pas de renommer mon fichier, j'aimerais changer de nom.

Invité · 12/04/2021, 01h26

Envoyé par dav2204

Il vous faut créer une boite de dialogue avec un TextBox ou une InputBox pour saisir le nom.

**dav2204** · 12/04/2021, 16h03

Pouvez-vous m’envoyer un Imprim écran svp ?

Invité · 12/04/2021, 16h25

Envoyé par dav2204

Code :

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

1
2
3
4
5
 
Dim NomFichier As String
 
    NomFichier = InputBox("Entrez le nom du fichier sans son extension", "Sauvegarde des fichiers", Split(ActiveDocument.Name, ".")(0))
    MsgBox NomFichier

**dav2204** · 12/04/2021, 18h34

Je suis désolé mais vous m'avez perdu ..

Invité · 12/04/2021, 20h16

Envoyé par dav2204

Je suis désolé mais vous m'avez perdu ..

Si vous exécutez la procédure ci-dessous, qu'obtenez-vous dans le MsgBox ?

Quelles modifications en déduisez-vous pour le code dans les procédures TestSauvegardeEnPdf et SauvegardeEnPdf ?
En clair, comment modifiez-vous le code pour tenir compte de NomFichier et du répertoire choisi ?

Code :

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

1
2
3
4
5
6
7
8
9
 
Sub Test() 
 
Dim NomFichier As String
 
    NomFichier = InputBox("Entrez le nom du fichier sans son extension", "Sauvegarde des fichiers", Split(ActiveDocument.Name, ".")(0))
    MsgBox NomFichier
 
End Sub

**dav2204** · 12/04/2021, 21h47

Pour l'instant j'ai juste copier-coller vos formules sans ajustements.
Pour la dernière procédure, j'ai une fenêtre qui s'ouvre en me demandant "entrez le nom du fichier sans son extension" Quand je valide rien ne se passe.

Invité · 13/04/2021, 07h12

Envoyé par dav2204

Ceci est ma dernière contribution.

Bon courage.

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
 
Sub TestSauvegardeEnPdf()
 
Dim Fd As FileDialog
Dim vrtSelectedItem As Variant
Dim RepertoireChoisi As Variant
Dim NomFichier As String
 
    'ChDir ActiveDocument.Path
 
    NomFichier = InputBox("Entrez le nom du fichier sans son extension", "Sauvegarde des fichiers", Split(ActiveDocument.Name, ".")(0))
 
    RepertoireChoisi = ""
    Set Fd = Application.FileDialog(msoFileDialogFolderPicker)
    With Fd
         If .Show = -1 Then
            Debug.Print vrtSelectedItem
            For Each vrtSelectedItem In .SelectedItems
                RepertoireChoisi = vrtSelectedItem
            Next vrtSelectedItem
         End If
    End With
 
    If RepertoireChoisi <> "" Then SauvegardeEnPdf ActiveDocument.Name, RepertoireChoisi, NomFichier
 
    MsgBox "Fin de la copie !", vbInformation
 
    Set Fd = Nothing
 
End Sub
 
 
Sub SauvegardeEnPdf(ByVal NomDuFichierDoc As String, ByVal RepertoireDeDestination As String, NomFichier2 As String)
 
Dim DocEnCours As Document
Dim NomWord As String, NomPdf As String, Extension As String
Dim Fso As Object
 
    Set DocEnCours = Documents(NomDuFichierDoc)
 
    NomPdf = RepertoireDeDestination & "\" & NomFichier2 & ".pdf"
    DocEnCours.ExportAsFixedFormat OutputFileName:=NomPdf, ExportFormat:=wdExportFormatPDF, OpenAfterExport:=False
 
    Set Fso = CreateObject("Scripting.FileSystemObject")
    With Fso
         Extension = .GetExtensionName(DocEnCours.FullName)
         NomWord = RepertoireDeDestination & "\" & NomFichier2 & "." & Extension
         .CopyFile DocEnCours.FullName, NomWord, True
    End With
 
    Set Fso = Nothing
    Set DocEnCours = Nothing
 
End Sub

Enregistrer 2 formats en même temps

Word

Discussions similaires

Partager

Partager