afficher boite de dialogue et récupérer le lien de l'emplacement

Version imprimable

Bonjour,

J'ai un soucis avec ma macro. celle ci génère automatiquement un courrier word à partir d'un model. cependant, j'aimerais permettre à l'utilisateur de choisir un
son propre emplacement pour l'enregistrement du courrier généré tout e lui proposant lorsque la macro est lancée un emplacement par défaut qui sera son propre fichier mes documents. jusqu'ici ma macro force plutot l'enregistrement vers un dossier copies comme vous pouvez le voir dans le code si dessous :

Merci de bien vouloir me venir en aide.

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
 
Private Sub CommandButton1_Click()
 
    Dim WordApp As Object, WordDoc As Object
    Dim Fichier As String, FichierCopie As String, Titre As String
    Dim i As Byte, Lign As Byte, NbLign As Byte, Cel As Byte, NvLign As Byte
    Dim nbpage As Byte, cptpage As Byte
    Dim cfichier As New Scripting.FileSystemObject
 
    Application.DisplayAlerts = False
 
           'Adhérent Unique
           Fichier = "C:\macros\Production\Bancassaurance\Courrier Facture\Model\CourFact.docx"
 
           Titre = "Courrier Facture " & TextBox1 & " du " & Format(TextBox2, "dd-mm-yyyy")
 
           'MsgBox Titre
           If cfichier.FileExists("C:\macros\Production\Bancassaurance\Courrier Facture\Copies\" & Titre & ".docx") Then
               MsgBox "Ce nom de fichier existe déjà, veuillez essayer un autre nom!"
               End
           End If
 
           cfichier.CopyFile Fichier, "C:\macros\Production\Bancassaurance\Courrier Facture\Copies\" & Titre & ".docx", True 'False
           'False
           FichierCopie = "C:\macros\Production\Bancassaurance\Courrier Facture\Copies\" & Titre & ".docx"
           Set cfichier = Nothing
 
           If Dir(Fichier) <> "" Then
               Set WordApp = CreateObject("word.application")
               Set WordDoc = WordApp.Documents.Open(FichierCopie)
 
               For i = 1 To 20
                   If i = 5 Then
                       dform = Cells(6, i)
                       madate = Format(dform, "dd mmmm yyyy")
                       WordDoc.Bookmarks("Signet" & i).Range.Text = madate
                   ElseIf i = 19 Then
                       dform = Cells(6, i)
                       madate = Format(dform, "mmmm yyyy")
                       If madate Like "a*" Or madate Like "o*" Then
                            WordDoc.Bookmarks("Signet" & i).Range.Text = "d" & "'" & madate
                       Else
                            WordDoc.Bookmarks("Signet" & i).Range.Text = "de " & madate
                       End If
                   ElseIf i = 10 Then
                       dele = Cells(6, i)
                       If dele <> "" Then
                            WordDoc.Bookmarks("Signet" & i).Range.Text = "- " & dele
                       Else
                            WordDoc.Bookmarks("Signet" & i).Range.Text = dele
                       End If
                   ElseIf i = 9 Then
                       dform = Cells(6, i)
                       nombr = Format(dform, "#,0")
                       WordDoc.Bookmarks("Signet" & i).Range.Text = nombr
                   Else
                       WordDoc.Bookmarks("Signet" & i).Range.Text = Cells(6, i)
                   End If
               Next i
 
           Else
               MsgBox "Fichier introuvable"
               End
           End If
 
    WordDoc.Save
    WordApp.Visible = True    'affiche le document Word
    'WordDoc.PrintOut          'Pour imprimer le doc obtenu
    'WordDoc.Close True        'ferme le document word en sauvegardant les données
    'WordApp.Quit              'ferme la session Word
    Unload Me
    MsgBox ("Courrier générer avec succès !")
 
End Sub

23/04/2015, 21h08
clementmarcotte

Bonjour,

C'est complètement inutile de créer une nouvelle instance de Word à partir de Word ?

Comme ce n'est pas mon habitude de donner le poisson, je vais t'apprendre à pêcher:

Dans ton aide de VBA:

Dialogs pour utiliser les boîtes de dialogue de Word

Tu prends l'exemple de l'aide et tu changes wdDialogFileOpen ===> Fichier - Ouvrir par wdDialogfileSaveAs ===> Fichier - Enregistrer sous...

Pour avoir toutes les boîtes disponibles:

cherche : WdWordDialog

sélectionne:

WdWordDialog, énumération
24/04/2015, 11h50
saninx

mon souci et j'ai oublié de le mentionner je part d'une macro sur excel qui génère le courrier word, donc j'utilise la boite de dialogue enregistrer sous de quel application, word ou excel ?
24/04/2015, 20h49
clementmarcotte

Citation:

Envoyé par saninx

mon souci et j'ai oublié de le mentionner je part d'une macro sur excel qui génère le courrier word, donc j'utilise la boite de dialogue enregistrer sous de quel application, word ou excel ?

Si tu utilises Excel pour générer un fichier Word, c'est Word qui est responsable de l'enregistrement, c'est juste plus simple, parce que Excel n'est pas capable d'enregistrer au format Word et Word n'est pas capable d'enregistrer au format Excel.

Si tu n'utilises pas la bonne, ce ne devrait pas être tragique. Tu vas juste devoir récupérer les informations dans des variables et ne pas enregistrer. Ensuite, tu fais enregistrer par le bon programme, sans passer par les boîtes de dialogue.

j'ai essayé de suivre vos recommandations je suis arrivé à ce code, mais j'ai une erreur : le membre de cette collection n'existe pas à cette ligne

Code:

Set chemin = WordApp.Dialogs(wdDialogFileSaveAs)

voici mon code:

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
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
 
Private Sub CommandButton1_Click()
 
    Dim WordApp As Object, WordDoc As Object
    Dim chemin As FileDialog
    Dim Fichier As String, FichierCopie As String, Titre As String, repertoir As String
    Dim i As Byte, Lign As Byte, NbLign As Byte, Cel As Byte, NvLign As Byte
    Dim nbpage As Byte, cptpage As Byte
    Dim cfichier As New Scripting.FileSystemObject
 
    Application.DisplayAlerts = False
    Lign = 21
    While (ActiveSheet.Cells(Lign, 1) <> "")
        Lign = Lign + 1
    Wend
 
    Set WordApp = CreateObject("word.application")
 
    Titre = "Convocation VM " & TextBox1 & " du " & Format(TextBox2, "dd mm yyyy")
    repertoir = Environ("HOMEPATH")
    If cfichier.FileExists(repertoir & Titre & ".doc") Then
               MsgBox "Ce nom de fichier existe déjà, veuillez essayer un autre nom!"
               End
    End If
 
    If Lign = 21 Then
           'Adhérent Unique
           Fichier = "C:\macros\Production\corporate\Décès Collectif\Convocation VM\model\convocvmuniq.doc"
           cfichier.CopyFile Fichier, repertoir & Titre & ".doc", True 'False
 
           FichierCopie = repertoir & Titre & ".doc"
           Set cfichier = Nothing
 
           If Dir(Fichier) <> "" Then
               Set WordDoc = WordApp.Documents.Open(FichierCopie)
 
               For i = 1 To 13
                   If i = 6 Then
                       dform = Cells(6, i)
                       madate = Format(dform, "dd mmmm yyyy")
                       WordDoc.Bookmarks("Signet" & i).Range.Text = madate
                   ElseIf i = 8 Then
                       dform = Cells(6, i)
                       nombr = Format(dform, "#,0")
                       WordDoc.Bookmarks("Signet" & i).Range.Text = nombr
                   Else
                       WordDoc.Bookmarks("Signet" & i).Range.Text = Cells(6, i)
                   End If
               Next i
 
           Else
               MsgBox "Fichier introuvable"
               End
           End If
 
    ElseIf Lign > 21 Then
 
            'Adhérents Multiples
            Fichier = "C:\macros\Production\corporate\Décès Collectif\Convocation VM\model\convocvmulti.doc"
            cfichier.CopyFile Fichier, "C:\macros\Production\corporate\Décès Collectif\Convocation VM\copies\" & Titre & ".doc", True 'False
            'False
            FichierCopie = "C:\macros\Production\corporate\Décès Collectif\Convocation VM\copies\" & Titre & ".doc"
            Set cfichier = Nothing
 
            If Dir(Fichier) <> "" Then
                Set WordDoc = WordApp.Documents.Open(FichierCopie)
 
                For i = 1 To 11
                    If i = 6 Then
                       dform = Cells(17, i)
                       madate = Format(dform, "dd mmmm yyyy")
                       WordDoc.Bookmarks("Signet" & i).Range.Text = madate
                   ElseIf i = 8 Then
                       dform = Cells(17, i)
                       nombr = Format(dform, "#,0")
                       WordDoc.Bookmarks("Signet" & i).Range.Text = nombr
                    Else
                       WordDoc.Bookmarks("Signet" & i).Range.Text = Cells(17, i)
                   End If
                Next i
 
                'Gestion du tableau
                NbLign = Lign - 21
                NvLign = 21
                y = 1
                For Cel = 2 To (NbLign + 1)
                    WordDoc.Tables(1).Rows.Add
                    WordDoc.Tables(1).Columns(1).Cells(Cel).Range.Text = y
                    WordDoc.Tables(1).Columns(2).Cells(Cel).Range.Text = Range("A" & NvLign)
                    NvLign = NvLign + 1
                    y = y + 1
                Next Cel
                WordDoc.Tables(1).Rows(1).shading.backgroundpatterncolor = RGB(160, 160, 160)
                WordDoc.Tables(1).Columns(1).shading.backgroundpatterncolor = RGB(160, 160, 160)
                WordDoc.Tables(1).Rows(1).HeadingFormat = True
 
                'Vide la liste des adhérents
                Range("A21:A" & (Lign - 1)).ClearContents
 
            Else
                MsgBox "Fichier introuvable"
                End
            End If
    End If
 
 
    'Affiche la boite dialogue de sauvegarde avec la pre-saisie de la réf
    Set chemin = WordApp.Dialogs(wdDialogFileSaveAs)
    With chemin
        .Name = Titre & ".doc"
        .Show   ' On mémorise la réponse de la boite de dialogue
    End With
 
    'WordDoc.Save
    WordApp.Visible = True    'affiche le document Word
    'WordDoc.PrintOut          'Pour imprimer le doc obtenu
    'WordDoc.Close True        'ferme le document word en sauvegardant les données
    'WordApp.Quit              'ferme la session Word
    Unload Me
    MsgBox ("Courrier générer avec succès !")
 
End Sub

27/04/2015, 20h34
clementmarcotte

Bonjour,

Remplace wdDialogFileSaveAs par sa valeur numérique. Elle doit être dans la même fenêtre d'aide que celle qui donne le nom des constantes.
27/04/2015, 23h10
saninx

Merci pour m'avoir guidé, sa marche comme je le souhaite avec ta dernière recommandation. grand merci à toi.