Modification d'un fichier word à partir d'une macro Excel

Bonjour à tous

J'ai un problème simple que je n'arrive pas à résoudre.
Je souhaite faire une routine qui ouvre tous les fichiers word d'un répertoire donné, modifie une référence, enregistre et ferme le fichier pour passer au suivant.
Jusqu'ici, j'arrive à ouvrir le fichier word mais impossible de selectionner et remplacer les articles selectionnés.

Voici mon code

Sub MajArtCMF_RCA()

Application.ScreenUpdating = True

'DateFormateBudget.Show




Dim StrChemin As String
Dim StrFichier As String
Dim FichierActif As Word.Document
StrChemin = "C:\Users\d\Desktop\MiseAjourArtCMF\"
StrFichier = Dir(StrChemin & "*.rtf")


Do While StrFichier <> ""

Set MonApplication = CreateObject("Shell.Application")
MonApplication.Open (StrChemin & StrFichier)

ActiveDocument.Activate

Selection.Find.ClearFormatting <<<<<<<<<< ca plante ici
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = "823-9"
.Replacement.Text = "821-53"
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With


Selection.Find.Execute
With Selection
If .Find.Forward = True Then
.Collapse Direction:=wdCollapseStart
Else
.Collapse Direction:=wdCollapseEnd
End If
.Find.Execute Replace:=wdReplaceOne
If .Find.Forward = True Then
.Collapse Direction:=wdCollapseEnd
Else
.Collapse Direction:=wdCollapseStart
End If
.Find.Execute
End With

Windows("Document1").Activate




ActiveDocument.Close savechanges:=True
StrFichier = Dir()
Application.StatusBar = StrFichier & " traitée"

Loop

Application.StatusBar = "Terminé"

End Sub

Pourriez-vous m'aider car je ne comprends pas vraiment le fonctionnement des macros incluant du Word ?

Merci d'avance.

Bonjour

Au lieu de
MonApplication.Open (StrChemin & StrFichier)

Mettre
Dim doc As Word.Document
Set doc = MonApplication.Open (StrChemin & StrFichier)
if Not doc Is Nothing Then
....
traitement
End if

Salut,

Quitte à utiliser Word, autant le faire correctement. Passer par l'objet Shell est inutile:

Code:

---

1 2 3 4 5

Dim Wd As Word.Application Set Wd = New word.Application   Dim Doc As Word.Document Set Doc = wd.Open(StrChemin & StrFichier)

---

Vire ces horribles Application.ScreenUpdating = True et abandonne ce reflexe malsain.
1) Tu n'as aucun retour sur ce qui se passe (le document est il bien ouvert ? y'a t'il un popup intempestif ? ect ...)
2) L'optimisation, s'il y a lieux, c'est après avoir obtenu le comportement désiré et jamais avant.

Code:

---

Selection.Find.ClearFormatting

---

Ton code est ambigu.
Parle t'on de l'objet sélection d'Excel ou de Word ?
A mon avis, il s'agit d'Excel, a ton avis il s'Agit de Word.
Utilise des références explicites.
Exemple:

Code:

---

1 2	Wd.selection '// Selection dans Word ThisWorkbook.Application.Selection '// Selection dans Excel

---

Merci pour vos réponses.

J'arrive bien à ouvrir le fichier word.

Ce que je n'arrive pas à faire, c'est la suite des opérations à savoir, si c'est indispensable, spécifier que le fichier ouvert est le document sur lequel doit être faite la correction, et rechercher et remplacer les articles spécifiés.

Désolé de vous ennuyer mais je ne sais pas faire avec Word. Et je précise que je veux modifier un fichier word à partir d'une macro excel car effectivement, ca peut porter à confusiion.

Auriez-vous un code que je puisse utiliser ?

Merci d'avance.

Du peut d'expérience que j'en ai eut, Word est une plaie à manipuler ...

Plutôt que faire des recherches et remplacements de chaînes, ce qui à la longue peut se révéler imprécis, lourd et fastidieux,
as-tu songé au publipostage ?

Bonjour,
La meilleure façon de maintenir une application c'est de diviser chaque action à réaliser en plusieurs procédures dite "générique", c'est à dire réutilisable
Dans votre demande, il y a d'abord charger le nom des fichiers Word à modifier (Fonction GetFileList) et ensuite une procédure qui se charge de Chercher et remplacer une chaîne par une autre (

Il y a lieu de charger le code depuis ce billet VBA/Excel - Fonction qui renvoie la liste des fichiers d'un répertoire en fonction d'un critère


Un premier exemple en utilisant uniquement GetFileList et où l'on va chercher la liste des fichiers Word présent dans le sous-répertoire nommé "document" et on les affiche

Code:

---

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15

Sub Main_1() Const sF As String = "\Document\" ' Le nom du sous-dossier où se trouve les documents Word Dim t As Variant ' La table qui doit contenir la liste des fichiers word à modifier Dim r As String ' Le dossier racine Dim fN As String ' Le nom complet du répertoire où chercher les documents Dim m As String ' Message fN = ThisWorkbook.Path & sF t = GetFileList(fN & "*.docx") If IsArray(t) Then m = Join(t, vbCrLf) Else m = "Pas trouvé les documents" End If MsgBox m End Sub

---

Deuxième exemple où l'on va chercher la liste des fichiers Word présent dans le sous-répertoire nommé "document" et ensuite on ouvre et ferme les documents Word
Ne pas oublier de référencer la bibliothèque Word (Dans l'éditeur VBE, cliquer sur Outils/Références... et dans la boîte de dialogue Références - VBA Project sélectionner la bibliothèque Microsoft Word xx.x Object Library)

Code:

---

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20

Sub Main_2() Const sF As String = "\Document\" ' Nom du sous-dossier où se trouve les documents Word Const bM As String = "maReference" ' Nom du signet Dim oWrd As Word.Application ' Application Word Dim oDoc As Word.Document ' Document Word traité Dim t As Variant ' La table qui doit contenir la liste des fichiers word à modifier Dim r As String ' Le dossier racine Dim fN As String ' Le nom complet du répertoire où chercher les documents Dim e As Integer Set oWrd = New Word.Application fN = ThisWorkbook.Path & sF t = GetFileList(fN & "*.docx") If IsArray(t) Then For e = LBound(t) To UBound(t) Set oDoc = oWrd.Documents.Open(fN & t(e)) oDoc.Close Next End If Set oWrd = Nothing: Set oDoc = Nothing End Sub

---

On constate que cela fonctionne, il nous reste à intégrer une fonction générique qui fera l'équivalent d'un Rechercher/Remplacer soit la procédure générique ReplaceTextInWordDoc

Code:

---

1 2 3 4 5 6 7 8 9 10 11

Sub ReplaceTextInWordDoc(ByVal oDocument As Word.Document, _ ByVal LookupValue As String, _ ByVal ReplacementString As String) With oDocument.Content.Find .Text = LookupValue .Replacement.Text = ReplacementString .Forward = True .Wrap = wdFindContinue .Execute Replace:=wdReplaceAll End With End Sub

---

Que l'on invoquera depuis la procédure Main

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

Sub Main() Const sF As String = "\Document\" ' Nom du sous-dossier où se trouve les documents Word Dim oWrd As Word.Application ' Application Word Dim oDoc As Word.Document ' Document Word traité Dim t As Variant ' La table qui doit contenir la liste des fichiers word à modifier Dim r As String ' Le dossier racine Dim fN As String ' Le nom complet du répertoire où chercher les documents Dim m As String Dim e As Integer Set oWrd = New Word.Application fN = ThisWorkbook.Path & sF t = GetFileList(fN & "*.docx") If IsArray(t) Then For e = LBound(t) To UBound(t) Set oDoc = oWrd.Documents.Open(fN & t(e)) ReplaceTextInWordDoc oDocument:=oDoc, LookupValue:="823-9", ReplacementString:="821-53" ' On cherche "823-9" par "821-53" oDoc.Close Next m = "Action terminée" Else m = "Pas trouvé de document" End If MsgBox m Set oWrd = Nothing: Set oDoc = Nothing End Sub

---

Liens en adéquation avec ma réponse

• VBA/Excel - Fonction qui renvoie la liste des fichiers d'un répertoire en fonction d'un critère
• VBA Excel - Transférer des données d'excel vers Word
• Utiliser les variables tableaux en VBA Excel