Problème fermeture fichier .doc et appli word VBA

**thomas93** · 26/02/2014, 10h17

Bonjour à tous !

Je suis plutôt débutant en VBA et je suis tombé sur un problème depuis hier !

J'explique ce queje souhaite faire puis ce qu'il se fait en réalité :
Je souhaite :
-ouvrir un fichier
-remplir le fichier
-enregistrer sous le fichier
-fermer le fichier

et cela 3 trois en tout car j'ai 3 fichiers à remplir.

En réalité, il enregistre le premier fichier ouvert, 3 fois avec les bons nom demandés mais 3 fois la même chose. (Problème peut-etre avec le active.document)

Je ne comprends plus !

Voici mon code :

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
Private Sub CommandButton4_Click()
Dim WordObj As Object
Dim WordObj2 As Object
Dim WordObj3 As Object
 On Error Resume Next
 
Const Cible = "V:\Travaux_neufs\"
Dim objShell As Object
Dim objFolder As Object, objFolderItem As Object
 
Set objShell = CreateObject("Shell.Application")
Set objFolder = objShell.Namespace(Cible)
Set objFolderItem = objFolder.Self
 
MkDir objFolderItem.Path & "\" & ComboBox2.Value & "\" & TextBox2.Value
 
 Set WordObj = CreateObject("Word.Application.8")
 Set wrdDoc = WordObj.Documents.Open("C:\Users\tjoris\Desktop\Source\Page_dossier_etude.doc")
 'Pour afficher Word
 WordObj.Visible = True
 
With WordObj.Selection
 
    WordObj.Selection.MoveDown Unit:=wdLine, Count:=11
    WordObj.Selection.EndKey Unit:=wdLine
    WordObj.Selection.HomeKey Unit:=wdLine, Extend:=wdExtend
    WordObj.Selection.TypeText Text:=ComboBox1.Value
 
    WordObj.Selection.MoveDown Unit:=wdLine, Count:=5
    WordObj.Selection.MoveLeft Unit:=wdWord, Count:=1
    WordObj.Selection.EndKey Unit:=wdLine, Extend:=wdExtend
    WordObj.Selection.TypeText Text:=ComboBox2.Value
    WordObj.Selection.MoveDown Unit:=wdLine, Count:=2
    WordObj.Selection.MoveLeft Unit:=wdWord, Count:=1
    WordObj.Selection.EndKey Unit:=wdLine, Extend:=wdExtend
    WordObj.Selection.TypeText Text:=TextBox2.Value
    WordObj.Selection.MoveDown Unit:=wdLine, Count:=2
    WordObj.Selection.MoveLeft Unit:=wdWord, Count:=1
    WordObj.Selection.EndKey Unit:=wdLine, Extend:=wdExtend
    WordObj.Selection.TypeText Text:=TextBox3.Value
    WordObj.Selection.MoveDown Unit:=wdLine, Count:=16
    WordObj.Selection.EndKey Unit:=wdLine, Extend:=wdExtend
    WordObj.Selection.InsertDateTime Format(Now, "dd.m.yyyy")
 
    ChangeFileOpenDirectory "V:\Travaux_neufs\" & ComboBox2.Value & "\" & TextBox2.Value
    ActiveDocument.SaveAs Filename:= _
        "V:\Travaux_neufs\" & (ComboBox2.Value) & "\" & TextBox2.Value & "\Page_dossier_etude.doc", FileFormat:= _
        wdFormatDocument, LockComments:=False, Password:="", AddToRecentFiles:= _
        True, WritePassword:="", ReadOnlyRecommended:=False, EmbedTrueTypeFonts:= _
        False, SaveNativePictureFormat:=False, SaveFormsData:=False, _
        SaveAsAOCELetter:=False
 End With
 
 
 
 Set WordObj2 = CreateObject("Word.Application.8")
 Set wrdDoc = WordObj2.Documents.Open("C:\Users\tjoris\Desktop\Source\Page_dossier_travaux.doc")
 'Pour afficher Word
 WordObj2.Visible = True
 
 With WordObj2.Selection
    WordObj2.Selection.MoveDown Unit:=wdLine, Count:=23
    WordObj2.Selection.MoveLeft Unit:=wdWord, Count:=1
    WordObj2.Selection.EndKey Unit:=wdLine, Extend:=wdExtend
    WordObj2.Selection.TypeText Text:=ComboBox2.Value
    WordObj2.Selection.MoveDown Unit:=wdLine, Count:=2
    WordObj2.Selection.MoveLeft Unit:=wdWord, Count:=1
    WordObj2.Selection.EndKey Unit:=wdLine, Extend:=wdExtend
    WordObj2.Selection.TypeText Text:=TextBox2.Value
    WordObj2.Selection.MoveDown Unit:=wdLine, Count:=2
    WordObj2.Selection.MoveLeft Unit:=wdWord, Count:=1
    WordObj2.Selection.EndKey Unit:=wdLine, Extend:=wdExtend
    WordObj2.Selection.TypeText Text:=TextBox3.Value
 
    ChangeFileOpenDirectory "V:\Travaux_neufs\" & ComboBox2.Value & "\" & TextBox2.Value
    ActiveDocument.SaveAs Filename:= _
        "V:\Travaux_neufs\" & (ComboBox2.Value) & "\" & TextBox2.Value & "\Page_dossier_travaux.doc", FileFormat:= _
        wdFormatDocument, LockComments:=False, Password:="", AddToRecentFiles:= _
        True, WritePassword:="", ReadOnlyRecommended:=False, EmbedTrueTypeFonts:= _
        False, SaveNativePictureFormat:=False, SaveFormsData:=False, _
        SaveAsAOCELetter:=False
 End With
 
 
 Set WordObj3 = CreateObject("Word.Application.8")
 Set wrdDoc = WordObj3.Documents.Open("C:\Users\tjoris\Desktop\Source\Page_etude_piece.doc")
 'Pour afficher Word
 WordObj3.Visible = True
 
 With WordObj.Selection
    WordObj3.Selection.MoveDown Unit:=wdLine, Count:=6
    WordObj3.Selection.EndKey Unit:=wdLine, Extend:=wdExtend
    WordObj3.Selection.TypeText Text:=ComboBox2.Value
    WordObj3.Selection.MoveDown Unit:=wdLine, Count:=2
    WordObj3.Selection.MoveLeft Unit:=wdWord, Count:=1
    WordObj3.Selection.EndKey Unit:=wdLine, Extend:=wdExtend
    WordObj3.Selection.TypeText Text:=TextBox2.Value
 
    WordObj3.Selection.MoveDown Unit:=wdLine, Count:=8
    WordObj3.Selection.MoveRight Unit:=wdCharacter, Count:=1
    WordObj3.Selection.MoveDown Unit:=wdLine, Count:=6
    WordObj3.Selection.EndKey Unit:=wdLine, Extend:=wdExtend
    WordObj3.Selection.TypeText Text:=ComboBox2.Value
    WordObj3.Selection.MoveDown Unit:=wdLine, Count:=2
    WordObj3.Selection.MoveLeft Unit:=wdWord, Count:=1
    WordObj3.Selection.EndKey Unit:=wdLine, Extend:=wdExtend
    WordObj3.Selection.TypeText Text:=TextBox2.Value
 
    WordObj3.Selection.MoveDown Unit:=wdLine, Count:=9
    WordObj3.Selection.MoveRight Unit:=wdCharacter, Count:=1
    WordObj3.Selection.MoveDown Unit:=wdLine, Count:=6
    WordObj3.Selection.EndKey Unit:=wdLine, Extend:=wdExtend
    WordObj3.Selection.TypeText Text:=ComboBox2.Value
    WordObj3.Selection.MoveDown Unit:=wdLine, Count:=2
    WordObj3.Selection.MoveLeft Unit:=wdWord, Count:=1
    WordObj3.Selection.EndKey Unit:=wdLine, Extend:=wdExtend
    WordObj3.Selection.TypeText Text:=TextBox2.Value
 
    WordObj3.Selection.MoveDown Unit:=wdLine, Count:=9
    WordObj3.Selection.MoveRight Unit:=wdCharacter, Count:=1
    WordObj3.Selection.MoveDown Unit:=wdLine, Count:=6
    WordObj3.Selection.EndKey Unit:=wdLine, Extend:=wdExtend
    WordObj3.Selection.TypeText Text:=ComboBox2.Value
    WordObj3.Selection.MoveDown Unit:=wdLine, Count:=2
    WordObj3.Selection.MoveLeft Unit:=wdWord, Count:=1
    WordObj3.Selection.EndKey Unit:=wdLine, Extend:=wdExtend
    WordObj3.Selection.TypeText Text:=TextBox2.Value
 
    WordObj3.Selection.MoveDown Unit:=wdLine, Count:=8
    WordObj3.Selection.MoveRight Unit:=wdCharacter, Count:=1
    WordObj3.Selection.MoveDown Unit:=wdLine, Count:=6
    WordObj3.Selection.EndKey Unit:=wdLine, Extend:=wdExtend
    WordObj3.Selection.TypeText Text:=ComboBox2.Value
    WordObj3.Selection.MoveDown Unit:=wdLine, Count:=2
    WordObj3.Selection.MoveLeft Unit:=wdWord, Count:=1
    WordObj3.Selection.EndKey Unit:=wdLine, Extend:=wdExtend
    WordObj3.Selection.TypeText Text:=TextBox2.Value
    ChangeFileOpenDirectory "V:\Travaux_neufs\" & ComboBox2.Value & "\" & TextBox2.Value
    ActiveDocument.SaveAs Filename:= _
        "V:\Travaux_neufs\" & (ComboBox2.Value) & "\" & TextBox2.Value & "\Page_etude_piece.doc", FileFormat:= _
        wdFormatDocument, LockComments:=False, Password:="", AddToRecentFiles:= _
        True, WritePassword:="", ReadOnlyRecommended:=False, EmbedTrueTypeFonts:= _
        False, SaveNativePictureFormat:=False, SaveFormsData:=False, _
        SaveAsAOCELetter:=False
 End With
 
Unload Me
End
End Sub

Je vous remercie de votre aide !

Thomas

**thomas93** · 26/02/2014, 10h45

Le problème est résolu mais maintenant je cherche à quitter complétement Word à la fin :
J'ai essayer

Code :

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

1
2
Dim Appli As Word.Application
Appli.Quit

Mais ca ne quitte pas Word :/

Voici le nouveau code général :

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
Private Sub CommandButton4_Click()
Dim WordObj As Object
Dim WordObj2 As Object
Dim WordObj3 As Object
Dim Appli As Word.Application
 On Error Resume Next
 
Const Cible = "V:\Travaux_neufs\"
Dim objShell As Object
Dim objFolder As Object, objFolderItem As Object
 
Set objShell = CreateObject("Shell.Application")
Set objFolder = objShell.Namespace(Cible)
Set objFolderItem = objFolder.Self
 
MkDir objFolderItem.Path & "\" & ComboBox2.Value & "\" & TextBox2.Value
 
 Set WordObj = CreateObject("Word.Application.8")
 Set wrdDoc = WordObj.Documents.Open("C:\Users\tjoris\Desktop\Source\Page_dossier_etude.doc")
 'Pour afficher Word
 WordObj.Visible = True
 
With WordObj.Selection
 
    WordObj.Selection.MoveDown Unit:=wdLine, Count:=11
    WordObj.Selection.EndKey Unit:=wdLine
    WordObj.Selection.HomeKey Unit:=wdLine, Extend:=wdExtend
    WordObj.Selection.TypeText Text:=ComboBox1.Value
 
    WordObj.Selection.MoveDown Unit:=wdLine, Count:=5
    WordObj.Selection.MoveLeft Unit:=wdWord, Count:=1
    WordObj.Selection.EndKey Unit:=wdLine, Extend:=wdExtend
    WordObj.Selection.TypeText Text:=ComboBox2.Value
    WordObj.Selection.MoveDown Unit:=wdLine, Count:=2
    WordObj.Selection.MoveLeft Unit:=wdWord, Count:=1
    WordObj.Selection.EndKey Unit:=wdLine, Extend:=wdExtend
    WordObj.Selection.TypeText Text:=TextBox2.Value
    WordObj.Selection.MoveDown Unit:=wdLine, Count:=2
    WordObj.Selection.MoveLeft Unit:=wdWord, Count:=1
    WordObj.Selection.EndKey Unit:=wdLine, Extend:=wdExtend
    WordObj.Selection.TypeText Text:=TextBox3.Value
    WordObj.Selection.MoveDown Unit:=wdLine, Count:=16
    WordObj.Selection.EndKey Unit:=wdLine, Extend:=wdExtend
    WordObj.Selection.InsertDateTime Format(Now, "dd.m.yyyy")
 
    ChangeFileOpenDirectory "V:\Travaux_neufs\" & ComboBox2.Value & "\" & TextBox2.Value
    ActiveDocument.SaveAs Filename:= _
        "V:\Travaux_neufs\" & (ComboBox2.Value) & "\" & TextBox2.Value & "\Page_dossier_etude.doc", FileFormat:= _
        wdFormatDocument, LockComments:=False, Password:="", AddToRecentFiles:= _
        True, WritePassword:="", ReadOnlyRecommended:=False, EmbedTrueTypeFonts:= _
        False, SaveNativePictureFormat:=False, SaveFormsData:=False, _
        SaveAsAOCELetter:=False
    ActiveDocument.Close
 End With
 
 
 Set wrdDoc2 = WordObj.Documents.Open("C:\Users\tjoris\Desktop\Source\Page_dossier_travaux.doc")
 'Pour afficher Word
 WordObj.Visible = True
 
 With wrdDoc2.Selection
    WordObj.Selection.MoveDown Unit:=wdLine, Count:=23
    WordObj.Selection.MoveLeft Unit:=wdWord, Count:=1
    WordObj.Selection.EndKey Unit:=wdLine, Extend:=wdExtend
    WordObj.Selection.TypeText Text:=ComboBox2.Value
    WordObj.Selection.MoveDown Unit:=wdLine, Count:=2
    WordObj.Selection.MoveLeft Unit:=wdWord, Count:=1
    WordObj.Selection.EndKey Unit:=wdLine, Extend:=wdExtend
    WordObj.Selection.TypeText Text:=TextBox2.Value
    WordObj.Selection.MoveDown Unit:=wdLine, Count:=2
    WordObj.Selection.MoveLeft Unit:=wdWord, Count:=1
    WordObj.Selection.EndKey Unit:=wdLine, Extend:=wdExtend
    WordObj.Selection.TypeText Text:=TextBox3.Value
 
    ChangeFileOpenDirectory "V:\Travaux_neufs\" & ComboBox2.Value & "\" & TextBox2.Value
    ActiveDocument.SaveAs Filename:= _
        "V:\Travaux_neufs\" & (ComboBox2.Value) & "\" & TextBox2.Value & "\Page_dossier_travaux.doc", FileFormat:= _
        wdFormatDocument, LockComments:=False, Password:="", AddToRecentFiles:= _
        True, WritePassword:="", ReadOnlyRecommended:=False, EmbedTrueTypeFonts:= _
        False, SaveNativePictureFormat:=False, SaveFormsData:=False, _
        SaveAsAOCELetter:=False
    ActiveDocument.Close
 End With
 
 
 Set wrdDoc3 = WordObj.Documents.Open("C:\Users\tjoris\Desktop\Source\Page_etude_piece.doc")
 'Pour afficher Word
 WordObj.Visible = True
 
 With wrdDoc3.Selection
    WordObj.Selection.MoveDown Unit:=wdLine, Count:=6
    WordObj.Selection.EndKey Unit:=wdLine, Extend:=wdExtend
    WordObj.Selection.TypeText Text:=ComboBox2.Value
    WordObj.Selection.MoveDown Unit:=wdLine, Count:=2
    WordObj.Selection.MoveLeft Unit:=wdWord, Count:=1
    WordObj.Selection.EndKey Unit:=wdLine, Extend:=wdExtend
    WordObj.Selection.TypeText Text:=TextBox2.Value
 
    WordObj.Selection.MoveDown Unit:=wdLine, Count:=8
    WordObj.Selection.MoveRight Unit:=wdCharacter, Count:=1
    WordObj.Selection.MoveDown Unit:=wdLine, Count:=6
    WordObj.Selection.EndKey Unit:=wdLine, Extend:=wdExtend
    WordObj.Selection.TypeText Text:=ComboBox2.Value
    WordObj.Selection.MoveDown Unit:=wdLine, Count:=2
    WordObj.Selection.MoveLeft Unit:=wdWord, Count:=1
    WordObj.Selection.EndKey Unit:=wdLine, Extend:=wdExtend
    WordObj.Selection.TypeText Text:=TextBox2.Value
 
    WordObj.Selection.MoveDown Unit:=wdLine, Count:=9
    WordObj.Selection.MoveRight Unit:=wdCharacter, Count:=1
    WordObj.Selection.MoveDown Unit:=wdLine, Count:=6
    WordObj.Selection.EndKey Unit:=wdLine, Extend:=wdExtend
    WordObj.Selection.TypeText Text:=ComboBox2.Value
    WordObj.Selection.MoveDown Unit:=wdLine, Count:=2
    WordObj.Selection.MoveLeft Unit:=wdWord, Count:=1
    WordObj.Selection.EndKey Unit:=wdLine, Extend:=wdExtend
    WordObj.Selection.TypeText Text:=TextBox2.Value
 
    WordObj.Selection.MoveDown Unit:=wdLine, Count:=9
    WordObj.Selection.MoveRight Unit:=wdCharacter, Count:=1
    WordObj.Selection.MoveDown Unit:=wdLine, Count:=6
    WordObj.Selection.EndKey Unit:=wdLine, Extend:=wdExtend
    WordObj.Selection.TypeText Text:=ComboBox2.Value
    WordObj.Selection.MoveDown Unit:=wdLine, Count:=2
    WordObj.Selection.MoveLeft Unit:=wdWord, Count:=1
    WordObj.Selection.EndKey Unit:=wdLine, Extend:=wdExtend
    WordObj.Selection.TypeText Text:=TextBox2.Value
 
    WordObj.Selection.MoveDown Unit:=wdLine, Count:=8
    WordObj.Selection.MoveRight Unit:=wdCharacter, Count:=1
    WordObj.Selection.MoveDown Unit:=wdLine, Count:=6
    WordObj.Selection.EndKey Unit:=wdLine, Extend:=wdExtend
    WordObj.Selection.TypeText Text:=ComboBox2.Value
    WordObj.Selection.MoveDown Unit:=wdLine, Count:=2
    WordObj.Selection.MoveLeft Unit:=wdWord, Count:=1
    WordObj.Selection.EndKey Unit:=wdLine, Extend:=wdExtend
    WordObj.Selection.TypeText Text:=TextBox2.Value
    ChangeFileOpenDirectory "V:\Travaux_neufs\" & ComboBox2.Value & "\" & TextBox2.Value
    ActiveDocument.SaveAs Filename:= _
        "V:\Travaux_neufs\" & (ComboBox2.Value) & "\" & TextBox2.Value & "\Page_etude_piece.doc", FileFormat:= _
        wdFormatDocument, LockComments:=False, Password:="", AddToRecentFiles:= _
        True, WritePassword:="", ReadOnlyRecommended:=False, EmbedTrueTypeFonts:= _
        False, SaveNativePictureFormat:=False, SaveFormsData:=False, _
        SaveAsAOCELetter:=False
    ActiveDocument.Close
 End With
Appli.Quit
Unload Me
End
End Sub

Si vous avez une idée ?!

Thomas

Problème fermeture fichier .doc et appli word VBA

Excel

Discussions similaires

Partager

Partager