call et dim défini dans Une autre VBA

**keranLatos** · 15/01/2021, 19h09

Bonjour ,
Je cherche à faire un callmacro dans Macro1 ou est défini cfile(strings) mais dans Macro je fais appel au cfile de Macro1 maïs je ne sais pas comment faire

Invité · 16/01/2021, 11h28

Envoyé par keranLatos

Difficile de comprendre. Les macros sont situées dans le même fichier ? Quel est votre code ?

**keranLatos** · 16/01/2021, 11h41

Bonjour ,
deja desoler oui mon message est peu claire je vous remet sa en clair , tous est dans le meme fichier .
Dans ce fichier j'ai un menu déroulant et selon le choix fais l'emplacement de sauvegarde change .
je vous met ma vba qui est surement pas clair ^^'

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
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
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
Private Sub Valider_Click()
 
Selection.WholeStory
With Selection.Find
.Text = "Pouponnière Unitée 1"
End With
Selection.Find.Execute
If Selection.Find.Found Then
Call pouponniere1
Else
    With Selection.Find
    .Text = "Pouponnière Unitée 2"
    End With
    Selection.Find.Execute
    If Selection.Find.Found Then
    Call pouponniere2
    Else
        With Selection.Find
        .Text = "Pouponnière Unitée 3"
        End With
        Selection.Find.Execute
        If Selection.Find.Found Then
        Call pouponniere3
        Else
            With Selection.Find
            .Text = "3-6"
            End With
            Selection.Find.Execute
            If Selection.Find.Found Then
            Call s36
            Else
            MsgBox "Merci de choisir votre service"
            Exit Sub
End Sub
Sub pouponniere1()
CFile = "R:\S0-3\Pouponnière\DOCUMENTS PARTAGES POUP\Unite 1\" 'Changer l'emplacement
Emaila = "aa@aa.fr" 'changer les mails
service = " Pouponnière Unitée 1" 'changer nom du service
Chef = "chef" 'changer nom du chef(fe)
Call allmacro
 
End Sub
Sub pouponniere2()
CFile = "R:\S0-3\Pouponnière\DOCUMENTS PARTAGES POUP\Unite 2\" 'Changer l'emplacement
Emaila = "aa@aa.frr" 'changer les mails
service = " Pouponnière Unitée 2" 'changer nom du service
Chef = "chef" 'changer nom du chef(fe)
Call allmacro
End Sub
Sub pouponniere3()
CFile = "R:\DGAS\DPPE\IDEF\S0-3\Pouponnière\DOCUMENTS PARTAGES POUP\Unite 3\" 'Changer l'emplacement
Emaila = "aa@aa.fr;" 'changer les mails
service = " Pouponnière Unitée 3" 'changer nom du service
Chef = "DEVEL Nathalie" 'changer nom du chef(fe)
Call allmacro
End Sub
Sub s36()
CFile = "R:\S3-6\Dossier Enfants\" 'Changer l'emplacement
Emaila = "aa@aa.fr" 'changer les mails
service = " s3-6" 'changer nom du service
Chef = "chef" 'changer nom du chef(fe)
Call allmacro
End Sub
Sub allmacro()
Dim OL As Object, EmailItem As Object
Dim strFileName As String, Nom As String, Prenom As String, Chemin_du_dossier As String, Chemin_du_dossier2 As String, Chemin_du_dossier3 As String, Chemin_du_dossier4 As String, chemin_du_dossier5 As String, Fichier As String
Dim Ates As String, Atest As String, Act As String, ext As String, sexe As String, route As String, routchemin As String, scol As String, scolaire As String, observ As String
Dim pdfAtest As String, pdfext As String, pdfroute As String, pdfscolaire As String, pdfobserv As String, obsv As String, route2 As String, sante As String
Dim scrHst, emplacement, Raccourci, cmu As String, cmuchemin As String, cmuchemin2 As String, datee As String, année As String, cmulien As String, Cmutexte As String
Dim FichierOriginal As String, FichierCopie As String
Dim xlApp As Excel.Application, xlBook As Excel.Workbook
Dim xlSheet As Excel.Worksheet, BMRange As Word.Range, strFich$
 
strFich = CFile2 & "Mairies.xlsx"
Set xlApp = CreateObject("Excel.Application")
Set xlBook = xlApp.Workbooks.Open(strFich)
Set xlSheet = xlBook.Sheets(1)
 
datee = Now()
année = Format(datee, "yyyy")
 
Nom = ActiveDocument.SelectContentControlsByTitle("Nom")(1).Range.Text
Prenom = ActiveDocument.SelectContentControlsByTitle("Prénom")(1).Range.Text
sexe = ActiveDocument.Tables(2).Rows(2).Cells(2).Range.Text
 
Chemin_du_dossier = CFile & Nom & " " & Prenom & "\"
Chemin_du_dossier2 = Chemin_du_dossier & "Administratif (acte de naissance - prise en charge - CMU-fiche d'admission...)\"
Chemin_du_dossier3 = Chemin_du_dossier & "Scolarité\"
Chemin_du_dossier4 = Chemin_du_dossier & "Notes\"
chemin_du_dossier5 = Chemin_du_dossier & "Santé\"
 
 
Fichier = "Admission de " & Nom & " " & Prenom
 
Ates = CFile2 & "Attestation.dotm"
Act = CFile2 & "Acte-de-naissance.dotm"
scol = CFile2 & "Assurance-scolaire.dotm"
routchemin = CFile2 & "Feuillederoute.dotm"
obsv = CFile2 & "Observation.dotm"
 
 
Atest = "Atestation de prise en charge de " & Nom & " " & Prenom & ".docm"
ext = "Demande d'extrait d'acte de naissance de " & Nom & " " & Prenom & ".docm"
route = "Fiche de route de " & Nom & " " & Prenom & ".docm"
route2 = "Fiche de route de " & Nom & " " & Prenom & " du " & Date & ".docm"
scolaire = "Astestation d'assurance de " & Nom & " " & Prenom & ".docm"
observ = "Observation de " & Nom & " " & Prenom & ".docm"
 
pdfAtest = "Atestation de prise en charge de " & Nom & " " & Prenom
pdfext = "Demande d'extrait d'acte de naissance de " & Nom & " " & Prenom
pdfroute = "Fiche de route de " & Nom & " " & Prenom
pdfscolaire = "Astestation d'assurance de " & Nom & " " & Prenom
pdfobserv = "Observation de " & Nom & " " & Prenom
 
Cmutexte = "CMU de " & Nom & " " & Prenom & ".pdf.lnk"
 
cmu = Chemin_du_dossier2 & Cmutexte
cmuchemin = Chemin_du_dossier & "Administratif (acte de naissance - prise en charge - CMU-fiche d'admission...)"
cmuchemin2 = Chemin_du_dossier & "Santé"
cmulien = CFile3 & année & "\" & Nom & " " & Prenom & ".pdf"
 
FichierOriginal = Chemin_du_dossier2 & Cmutexte
FichierCopie = chemin_du_dossier5 & Cmutexte
 
On Error Resume Next
 
 
 
    If Dir(Chemin_du_dossier2, vbDirectory) <> vbNullString Then
 
Application.ScreenUpdating = False
Application.DisplayAlerts = False
 
            Kill Chemin_du_dossier2 & Fichier & ".pdf"
            Kill Chemin_du_dossier2 & ext
            Kill Chemin_du_dossier2 & Atest
            Kill Chemin_du_dossier2 & Act
            Kill Chemin_du_dossier2 & route
            Kill Chemin_du_dossier4 & observ
            Kill Chemin_du_dossier2 & pdfAtest & ".pdf"
            Kill Chemin_du_dossier2 & pdfext & ".pdf"
            Kill Chemin_du_dossier2 & pdfroute & ".pdf"
            Kill Chemin_du_dossier3 & pdfscolaire & ".pdf"
 
        Call macroatestation
        Call macroroute
        Call fichesante
        Call exte
        Call scolair
        Call obsverat
 
 
        Documents(Fichier & ".docm").Activate
        ActiveDocument.SaveAs2 FileName:=Chemin_du_dossier2 & Fichier & ".docm", _
        FileFormat:=wdFormatXMLDocumentMacroEnabled
 
        ActiveDocument.SaveAs2 FileName:=Chemin_du_dossier2 & Fichier & ".docm", _
        FileFormat:=wdFormatXMLDocumentMacroEnabled
        Selection.Find.ClearFormatting
        ActiveDocument.ExportAsFixedFormat OutputFileName:= _
        Chemin_du_dossier2 & Fichier & ".pdf" _
        , ExportFormat:=wdExportFormatPDF, OpenAfterExport:=False, OptimizeFor:= _
        wdExportOptimizeForPrint, Range:=wdExportAllDocument, From:=1, To:=1, _
        Item:=wdExportDocumentContent, IncludeDocProps:=True, KeepIRM:=True, _
        CreateBookmarks:=wdExportCreateNoBookmarks, DocStructureTags:=True, _
        BitmapMissingFonts:=True, UseISO19005_1:=False
 
                Set OL = CreateObject("Outlook.Application")
                    Set EmailItem = OL.CreateItem(0) '
                        Set OL = CreateObject("Outlook.Application")
                        Set EmailItem = OL.CreateItem(0)
                        strFileName = Chemin_du_dossier2 & Fichier & ".pdf"
 
                            With EmailItem
                                .Subject = "Modification de  la Fiche Admission de " & Nom & " " & Prenom & " du service " & service
                                .body = "Bonjour," & Chr(13) & Chr(10) & Chr(13) & Chr(10) & "La fiche d'admission automatique de " & Nom & " " & Prenom & ", sur le service " & service & " à été modifié." & Chr(13) & Chr(10) & Chr(13) & Chr(10) & "Chef(fe) de service : " & Chef
                                .To = Emaila
                                .Attachments.Add strFileName
                                .Send
                            End With
                            Set EmailItem = Nothing
                            Set OL = Nothing
 
                                ActiveDocument.Close SaveChanges:=wdDoNotSaveChanges
 
                                    Kill Chemin_du_dossier2 & Atest
                                    Kill Chemin_du_dossier3 & scolaire
 
                                        Documents(Fichier & ".docm").Activate
                                        MsgBox "Votre admission a été modifié."
 
                                ActiveDocument.Save
                                ActiveDocument.Close
 
Else
MkDir (Chemin_du_dossier)
MkDir (Chemin_du_dossier2)
MkDir (Chemin_du_dossier & "\Scolarité")
MkDir (Chemin_du_dossier & "\Notes")
MkDir (Chemin_du_dossier & "\Santé")
MkDir (Chemin_du_dossier & "\Mesure-Convocation")
MkDir (Chemin_du_dossier & "\Courrier(calendrier,...)")
 
With ActiveDocument
 
        ChangeFileOpenDirectory Chemin_du_dossier2
        ActiveDocument.SaveAs2 FileName:=Fichier & ".docm", FileFormat _
        :=wdFormatXMLDocument, LockComments:=False, Password:="", _
        AddToRecentFiles:=True, WritePassword:="", ReadOnlyRecommended:=False, _
        EmbedTrueTypeFonts:=False, SaveNativePictureFormat:=False, SaveFormsData _
        :=False, SaveAsAOCELetter:=False, CompatibilityMode:=15
 
End With
 
Call macroatestation
Call macroroute
Call fichesante
Call exte
Call scolair
Call obsverat
 
 
Application.DisplayAlerts = False
Application.ScreenUpdating = False
 
    Documents(Fichier & ".docm").Activate
    Selection.Find.Replacement.ClearFormatting
 
                                With Selection.Find
                                    .Text = "Cliquez ou appuyez ici pour entrer du texte."
                                    .Replacement.Text = " "
                                    .Forward = True
                                    .Wrap = wdFindAsk
                                    .Format = False
                                    .MatchCase = False
                                    .MatchWholeWord = False
                                    .MatchWildcards = False
                                    .MatchSoundsLike = False
                                    .MatchAllWordForms = False
                                End With
                                Selection.Find.Execute Replace:=wdReplaceAll
 
        ActiveDocument.SaveAs2 FileName:=Chemin_du_dossier2 & Fichier & ".docm", _
        FileFormat:=wdFormatXMLDocumentMacroEnabled
        Selection.Find.ClearFormatting
        ActiveDocument.ExportAsFixedFormat OutputFileName:= _
        Chemin_du_dossier2 & Fichier & ".pdf" _
        , ExportFormat:=wdExportFormatPDF, OpenAfterExport:=False, OptimizeFor:= _
        wdExportOptimizeForPrint, Range:=wdExportAllDocument, From:=1, To:=1, _
        Item:=wdExportDocumentContent, IncludeDocProps:=True, KeepIRM:=True, _
        CreateBookmarks:=wdExportCreateNoBookmarks, DocStructureTags:=True, _
        BitmapMissingFonts:=True, UseISO19005_1:=False
 
                        Set OL = CreateObject("Outlook.Application")
                            Set EmailItem = OL.CreateItem(0) '
                                Set OL = CreateObject("Outlook.Application")
                                Set EmailItem = OL.CreateItem(0)
                                strFileName = Chemin_du_dossier2 & Fichier & ".pdf"
 
                                    With EmailItem
                                        .Subject = "Fiche Admission de " & Nom & " " & Prenom & " du " & Format(Date, "dd/mm/yyyy") & " du service " & service
                                        .body = "Bonjour," & Chr(13) & Chr(10) & Chr(13) & Chr(10) & " voici la fiche d'admission automatique du " & Format(Date, "dddd dd mmmm yyyy") & " de " & Nom & " " & Prenom & ", sur le service " & service & "." & Chr(13) & Chr(10) & Chr(13) & Chr(10) & "Chef(fe) de service : " & Chef
                                        .To = Emaila
                                        .Attachments.Add strFileName
                                        .Send
                                    End With
                                    Set EmailItem = Nothing
                                    Set OL = Nothing
                                        Documents.Add DocumentType:=wdNewBlankDocument
                                        Set scrHst = CreateObject("WScript.Shell")
                                        emplacement = scrHst.SpecialFolders(cmuchemin)
 
                                        Set Raccourci = scrHst.CreateShortcut(cmu)
                                        Raccourci.WorkingDirectory = emplacement
                                        Raccourci.TargetPath = cmulien
                                        Raccourci.Save
 
                                        Set Raccourci = Nothing
                                        Set scrHst = Nothing
 
        ActiveDocument.Close SaveChanges:=wdDoNotSaveChanges
        FileCopy FichierOriginal, FichierCopie
 
        Kill Chemin_du_dossier2 & Atest
        Kill Chemin_du_dossier3 & scolaire
 
        MsgBox "Votre Admission a été fait."
        ActiveDocument.Close
 
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End If
End Sub

ce qui m'intersse c'est que "allmacro" prenne en compte l'emplacement dans "pouponniere1" ou "pouponniere2" etc selon notre choix

Invité · 16/01/2021, 12h57

Envoyé par keranLatos

Hormis Valider_Click, il vous faut transférer vos procédures dans un module standard et déclarer vos variables en Public en tête du module. Sinon, définir vos variables dans Allmacro en tant que paramètres.

Code :

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

1
2
3
4
5
6
7
 
Option Explicit
 
Public CFile As String
Public Emaila As String
Public service As String
Public Chef As String

**keranLatos** · 16/01/2021, 14h13

rebonjour ,
je ne suis pas sur de comprendre mais du coup si par exemple je choisi "pouponniere 1 " comment mes macro vont savoir que le fichier doit etre enregistrer dans le bon dossier ?

Invité · 16/01/2021, 14h18

Envoyé par keranLatos

Il suffit de faire l'essai...
Parce que la portée de la variable cfile s'étend sur tout le projet. Lorsque la variable est "chargée" avec pouponniere 1, elle conserve sa valeur dans allmacro.

**keranLatos** · 16/01/2021, 14h19

aahhhhh d'accord mais du coup j'avais pas compris comme cela ^^ c'est aussi bete que sa ... Uu pardon j'essaye et je reviens pour vous dire merci .

**keranLatos** · 16/01/2021, 18h11

rebonjour , tous fonctionne merci, hors sujet mais j'ai vue que le select copie pouvais creer des effet "sapin de noel" j'aimerais savoir si il etais possible de plus en faire je sais que c'est cette partie de code qui fais sa :

Code :

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

1
2
3
4
5
6
7
8
9
Documents(Fichier & ".docm").Activate
            ActiveDocument.Tables(1).Rows(1).Cells(2).Select
            Selection.Range.Case = wdUpperCase
            ActiveDocument.Tables(1).Rows(1).Cells(2).Select
            Selection.Copy
            Documents(scolaire).Activate
            Selection.GoTo What:=wdGoToBookmark, Name:="NOM"
            Selection.PasteAndFormat (wdFormatPlainText)
            Selection.TypeBackspace

merci en tous cas

Invité · 16/01/2021, 18h28

Envoyé par keranLatos

Pour quelle raison vous instanciez deux fois Outlook ?

Sinon, je ne sais pas ce qu'est un effet sapin de noel. Quel est le problème ?

**keranLatos** · 16/01/2021, 18h30

l'email c'etait pour faire un envoie de mail automatique mais j'ai trouver le probleme ^^"
et avec les copier coller entre les fichier l'ecran clignote entre les fichier le temps de la macro

call et dim défini dans Une autre VBA

VBA Word

Discussions similaires

Partager

Partager