Discussion :

[DanRoz]

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.

[fraflt69]

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

[deedolith]

Salut,

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

Code :

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

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 :

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

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 :

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

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

[DanRoz]

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.

[deedolith]

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 ?

[Philippe Tulliez]

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 :

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

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 :

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
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 :

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

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 :

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
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