Bonjour,
Suite à un changement de poste informatique et une redirection des répertoires de mon profil je rencontre une erreur 4198 dans mon fichier excel:
Il s'agit à la base d'un fichier excel qui permet de créer un fichier Word a partir d'une ligne renseignée et d'imprimer ce fichier Word.
Sub test()
MonChemin = ThisWorkbook.Path 'Tous les fichiers xls et Doc doivent etre dans le meme dossier
LargeurBase = Range("IV1").End(xlToLeft).Column
If Application.CountIf(Columns(LargeurBase + 1), "X") = 0 Then Exit Sub
Set WordApp = CreateObject("Word.application")
For Each X In Range("A2:" & Range("A65536").End(xlUp).Address)
If X.Offset(0, LargeurBase) = "X" Then
'Inserer ici un test pour verifier l'existence du fichier Word
'WordApp.Visible = True
WordApp.Documents.Open Filename:=MonChemin & "\" & X & ".doc", ReadOnly:=True
Marqueur = 0
For Each Y In X.Resize(1, LargeurBase)
For Each Z In WordApp.ActiveDocument.Bookmarks 'Test si le signet existe
If Z = Cells(1, Y.Column) Then Marqueur = 1
Next
If Marqueur = 1 Then
Set MonSignet = WordApp.ActiveDocument.Bookmarks(Cells(1, Y.Column).Value).Range
MonSignet.Text = Format(Y.Value, "@")
WordApp.ActiveDocument.Bookmarks.Add Name:=Cells(1, Y.Column).Value, Range:=MonSignet
WordApp.ActiveDocument.Fields.Update
End If
Next
'Enregistrement du fichier Word avec le nom idoine
WordApp.ActiveDocument.SaveAs Filename:=MonChemin & "\" & X & " " & X.Offset(0, 1) & " " & Format(X.Offset(0, 9), "dd_mm_yy") & " " & X.Offset(0, 3), ReadOnlyRecommended:=False
If Sheets(1).CheckBox1 Then WordApp.ActiveDocument.PrintOut
WordApp.ActiveDocument.Close
End If
Next
WordApp.Quit 'On quitte Word
Set WordApp = Nothing 'On vide l'objet WordApp
End Sub
Le problème se situe sur la ligne : WordApp.Documents.Open Filename:=MonChemin & "\" & X & ".doc", ReadOnly:=True
Le X correspond au nom de fichier Word en l’occurrence DE (X="DE")
J'ai pensé qu'il s'agissait d'un problème avec la variable MonChemin...
Je précise je connais rien au VBA ce n'est pas moi qui est créé cette macro.
Suite à un changement de poste informatique et une redirection des répertoires de mon profil je rencontre une erreur 4198 dans mon fichier excel:
Il s'agit à la base d'un fichier excel qui permet de créer un fichier Word a partir d'une ligne renseignée et d'imprimer ce fichier Word.
Sub test()
MonChemin = ThisWorkbook.Path 'Tous les fichiers xls et Doc doivent etre dans le meme dossier
LargeurBase = Range("IV1").End(xlToLeft).Column
If Application.CountIf(Columns(LargeurBase + 1), "X") = 0 Then Exit Sub
Set WordApp = CreateObject("Word.application")
For Each X In Range("A2:" & Range("A65536").End(xlUp).Address)
If X.Offset(0, LargeurBase) = "X" Then
'Inserer ici un test pour verifier l'existence du fichier Word
'WordApp.Visible = True
WordApp.Documents.Open Filename:=MonChemin & "\" & X & ".doc", ReadOnly:=True
Marqueur = 0
For Each Y In X.Resize(1, LargeurBase)
For Each Z In WordApp.ActiveDocument.Bookmarks 'Test si le signet existe
If Z = Cells(1, Y.Column) Then Marqueur = 1
Next
If Marqueur = 1 Then
Set MonSignet = WordApp.ActiveDocument.Bookmarks(Cells(1, Y.Column).Value).Range
MonSignet.Text = Format(Y.Value, "@")
WordApp.ActiveDocument.Bookmarks.Add Name:=Cells(1, Y.Column).Value, Range:=MonSignet
WordApp.ActiveDocument.Fields.Update
End If
Next
'Enregistrement du fichier Word avec le nom idoine
WordApp.ActiveDocument.SaveAs Filename:=MonChemin & "\" & X & " " & X.Offset(0, 1) & " " & Format(X.Offset(0, 9), "dd_mm_yy") & " " & X.Offset(0, 3), ReadOnlyRecommended:=False
If Sheets(1).CheckBox1 Then WordApp.ActiveDocument.PrintOut
WordApp.ActiveDocument.Close
End If
Next
WordApp.Quit 'On quitte Word
Set WordApp = Nothing 'On vide l'objet WordApp
End Sub
Le problème se situe sur la ligne : WordApp.Documents.Open Filename:=MonChemin & "\" & X & ".doc", ReadOnly:=True
Le X correspond au nom de fichier Word en l’occurrence DE (X="DE")
J'ai pensé qu'il s'agissait d'un problème avec la variable MonChemin...
Je précise je connais rien au VBA ce n'est pas moi qui est créé cette macro.