Discussion :

[rosemary_antoine]

Bonjour à tous,

Je suis novice en VBA. comme indiqué dans le titre, je cherche à remplacer une liste de mots par une autre dans beaucoups de fichiers word.
Pour cela j'ai déjà pas mal cherché sur DVP et j'ai trouvé une macro dans le forum contribuez "Recherche d'un ou plusieurs mots d'une liste dans un Document - Trois options"
Mais je ne vois pas comment la modifier pour qu'elle me cherche les mots de la colonne de gauche et si il les trouve qu'ils les remplace dans tout le doc par le mot de la colonne de droite.
J'ai une grande liste de mots à remplacer, mais seulement un petit nombre par fichier word. J'ai écris un code qui met trop longtems et qui fini par planter :
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
Sub Replace_ANCIEN_NOUVEAU()
With ActiveDocument.Content.Find
 
    .ClearFormatting
    With .Replacement
        .ClearFormatting
        .Font.Color = wdColorRed
    End With
 
' A partir de cette zone coller les codes à remplacer
'--------------------------------------------------
.Execute FindText:="40036021", ReplaceWith:="5014426", _
Format:=True, Replace:=wdReplaceAll
.Execute FindText:="40036140", ReplaceWith:="5014427", _
Format:=True, Replace:=wdReplaceAll
.Execute FindText:="40000654", ReplaceWith:="5014428", _
Format:=True, Replace:=wdReplaceAll
.Execute FindText:="40000779", ReplaceWith:="5014429", _
Format:=True, Replace:=wdReplaceAll
........etc.............
 
end with
end sub

Je sais que certains vont s'arracher les cheveux mais bon....

Merci beaucoup pour votre aide.

Voici le lien ou j'ai trouvé quelqhe chose de bien mais je ne sais pas trop l'exploiter :
http://www.developpez.net/forums/d44...trois-options/

2 - La liste des mots et le texte sont placés dans deux documents différents.
Le document 1 contient la macro, et la liste des mots.
La liste des mots est un tableau Word à deux colonnes dans le premier document.
La colonne 1 contient les mots à rechercher, 1 mot par cellule
La colonne 2 est destinée à recevoir une croix si le mot est trouvé
Le texte à parcourir est dans le second document.

Les documents
"Tableau des mots.doc" contient la macro et le tableau des mots
"C:\Le Rep\Le Texte.doc" contient le texte
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
Sub ChercherTrouver()
Dim Doc1 As Document
Dim Doc2 As Document
Dim TableauDesMots(), ok As Boolean, i As Integer
Dim DerLigne As Byte
'Désactiver la mise à jour de l'application pour éviter les mouvements de pages
Application.ScreenUpdating = False
    Set Doc1 = Documents("Tableau des mots.doc") 'contient la macro
    Set Doc2 = Documents.Open("C:\Le Rep\Le Texte.doc") 'contient le texte
    DoEvents
    DerLigne = Doc1.Tables(1).Rows.Count
    ReDim Preserve TableauDesMots(DerLigne)
    For NoLigne = 1 To DerLigne
        TableauDesMots(NoLigne) = Doc1.Tables(1).Cell(NoLigne, 1)
        'Suppression de vbcrlf en fin de cellule
        'et ajout du No de ligne formaté sur 4 caractères
        TableauDesMots(NoLigne) = Trim(Left(TableauDesMots(NoLigne), _
        Len(TableauDesMots(NoLigne)) - 2)) & Right("0000" & NoLigne, 4)
    Next
 
    For i = 1 To UBound(TableauDesMots)
        ok = recherche(Left(TableauDesMots(i), Len(TableauDesMots(i)) - 4), Doc2)
        If ok Then
            'récup du No de ligne dans le tableau
            NoLigne = Val(Right(TableauDesMots(i), 4))
            'insertion d'une croix dans la colonne adjascente
            Doc1.Tables(1).Cell(NoLigne, 2).Range.Text = "X"
        End If
    Next
 
'Réactiver la mise à jour de l'application
Application.ScreenUpdating = True
End Sub
 
Function recherche(LeMot As String, Doc2 As Document) As Boolean
Dim Plage
    Set Plage = Doc2.Content
        With Plage.Find
            .Text = LeMot
            recherche = .Execute
        End With
End Function

[Heureux-oli]

Salut,

Voilà un exemple qui fait le remplacement de mots contenus dans un tableau.

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
 
Sub Testoli()
Dim myStr(2, 2) As String
Dim inti As Integer
Dim myBoo As Boolean
 
myStr(1, 1) = "galeries"
myStr(1, 2) = "It 1"
myStr(2, 1) = "pages"
myStr(2, 2) = "It 2"
myBoo = False
 
 
For inti = 1 To 2
 
Debug.Print myStr(inti, 1)
 
With Selection.Find
 
    .Text = myStr(inti, 1)
    .Replacement.Text = myStr(inti, 2)
    .Forward = True
    .Execute Replace:=wdReplaceAll
 
End With
 
Next inti
 
End Sub

Si on travaille avec une tableau situé dans un document, il faut déclarer un objet tableau et deux objets documents.

Pour la totalité, on obtient ceci :

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
 
Sub Testoli()
Dim oFol As Scripting.Folder
Dim oFil As Scripting.File
Dim FSO As FileSystemObject
Dim oDoc As Document
Dim oTbl As Table
Dim inti As Integer
Dim oDl As FileDialog
 
Set FSO = New FileSystemObject
Set oDl = Application.FileDialog(msoFileDialogFolderPicker)
oDl.Show
Set oFol = FSO.GetFolder(oDl.SelectedItems(1))
 
 
 
Set oTbl = ActiveDocument.Tables(1)
 
'Boucle sur les documents
For Each oFil In oFol.Files
Set oDoc = Documents.Open(oFil.Name)
oDoc.Select
'Boucle dans le document
For inti = 1 To oTbl.Rows.Count
With Selection.Find
 
    .Text = NetText(oTbl.Cell(inti, 1).Range.Text)
    .Replacement.Text = NetText(oTbl.Cell(inti, 2).Range.Text)
    .Forward = True
    .Execute Replace:=wdReplaceAll
 
End With
Next inti
oDoc.Save
oDoc.Close
Next oFil
 
Set oDoc = Nothing
Set FSO = Nothing
Set oFol = Nothing
Set oDl = Nothing
 
 
 
End Sub
'Fonction d'extraction du texte
Function NetText(stTemp As String) As String
NetText = Left(stTemp, Len(stTemp) - 2)
 
End Function

Le tableau doit avoir deux colonnes, la première avec le mot à chercher et la seconde, le mot qui remplace.

[rosemary_antoine]

Merci de répondre si prestement, je suis stupéfait,

Ta 1ère proposition marche bien mais j'ai peur que cela ne prenne trop de ressource car j'aurai un tableau de 2000 lignes (peut être que je me trompe, je vais le tester)

J'ai lancé ta 2 proposition mais le message "erreur de compilation Type défini par l'utilisateur non défini" s'affiche. L'aide m'indique que c'est peut être un type d'objet non défini dans ma bibliothèque ?

que faire ? J'ai la version 2007 de word.

a

[Heureux-oli]

Salut,

Toutes mes excuses.
Tu dois ajouter à ton projet la bibliothèque ScriptingRuntime pour avoir accès aux objets fichiers.

Si tu veux un tuto qui en parle :
http://warin.developpez.com/access/fichiers/

[rosemary_antoine]

Merci,
J'ai activé la bibliothèque. Cela fonctionne que sur le 1er fichier. A l'ouverture du 2è j'ai un message "erreur d'execution 5174 : fichier introuvable .."
Encore une histoire de bibliothèque à activer ?
Il bloque sur la ligne :

Set oDoc = Documents.Open(oFil.Name)

En passant, j'ai ajouté qu'il mettre en rouge les changements faits. Par la suite quelqu'un devra valider ces modifications. Est ce que mon code est le mieux placé ?
Aussi il faudra que la recherche se fasse dans les entêtes (il me semble qu'il y a quelque chose sur le forum).

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
Sub Testoli()
Dim oFol As Scripting.Folder
Dim oFil As Scripting.File
Dim FSO As FileSystemObject
Dim oDoc As Document
Dim oTbl As Table
Dim inti As Integer
Dim oDl As FileDialog
 
Set FSO = New FileSystemObject
Set oDl = Application.FileDialog(msoFileDialogFolderPicker)
oDl.Show
Set oFol = FSO.GetFolder(oDl.SelectedItems(1))
 
 
 
Set oTbl = ActiveDocument.Tables(1)
 
'Boucle sur les documents
For Each oFil In oFol.Files
Set oDoc = Documents.Open(oFil.Name)
oDoc.Select
'Boucle dans le document
For inti = 1 To oTbl.Rows.Count
With Selection.Find
 
    .Text = NetText(oTbl.Cell(inti, 1).Range.Text)
 
'Mon AJOUT*************
    .ClearFormatting
    With .Replacement
         .ClearFormatting
         .Font.Color = wdColorRed
    End With
'fin de Mon AJOUT*************
 
    .Replacement.Text = NetText(oTbl.Cell(inti, 2).Range.Text)
    .Forward = True
    .Execute Replace:=wdReplaceAll
 
End With
Next inti
oDoc.Save
oDoc.Close
Next oFil
 
Set oDoc = Nothing
Set FSO = Nothing
Set oFol = Nothing
Set oDl = Nothing
 
End Sub

[Heureux-oli]

Salut,

non, si elle bloque, c'est pour un autre problème.

La macro doit être dans le fichier qui contient la table avec les mots à remplacer.

[rosemary_antoine]

ok,
J'ai mis la macro dans le projet en testant dans Project/Module/New macro puis après dans project/Microsoft word objet/this document/
Mais cela fait la meme erreur
?

[rosemary_antoine]

Pour reprendre et être sûr :J'ai bien un fichier word ouvert avec dedans ma macro. le fichier word est enregistré en *.docm

[Heureux-oli]

Je vais donner la méthode que j'ai appliquée.


Dans le document qui contient la table.
Si je vais dans le VBE, je colle le code dans l'objet Thisdocument du projet qui contient le tableau.

y a-t-il des fichiers autres que des documents dans le répertoire?

[rosemary_antoine]

Il y a le Normal. présent.
Voici copie ecran

[Heureux-oli]

Il est au bon endroit.

Ce qui me chagrine un peu, c'est que j'ai fait le test sur quelques fichiers à la maison et tout est passé.

[rosemary_antoine]

Bonjour,

Je cherche aussi à remplacer des "motifs" de date dans tous mes documents word : c'est à dire que j'ai des dates diff dans mes docs et je dois les remplacer par une date unique choisie (la date du jour). Il faut faire appel aux expressions régulières mais je n'arrive pas à trouver laquelle. (mes dates sont de forme dd/mm/yyyy ou dd.mm.yyyy

[Sepia]

Salut,

Voici un tutoriel sur les recherches/remplacements

Si tu as besoin de plus d'infos, n'hésite pas.

[rosemary_antoine]

merci beaucoup je crois avoir trouvé pour les dates dans le tuto cité, je vais tester.

[rosemary_antoine]

J'ai toujours mon probleme d'erreur "fichier non trouvé" avec le code proposé par Heureux-Oli. Qn a une solution ?

Sinon,
Voici ce que j'ai fait pour trouver un motif date dans un fichier word et le remplacer via une inputBox. Je le poste dans nouvelle discussion en résolu pour ceux que ca intéresse... Je précise que je suis novice...

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
Sub date_rempla2()
'des infos sur recherche de motifs sur http://sepia.developpez.com/office/word/rechercherremplacer/
 
madate$ = WordBasic.[InputBox$]("Rentrer la nouvelle date au format JJ.MM.AAAA", "Rechercher / remplacer les dates    :D")
ActiveDocument.Select
 
With Selection.Find
    'cherche tous les formats de date du motif: j.mm.aaaa ou jj.mm.aaaa
    .Text = "([0-9]{1;2}).([0-9]{2}).([0-9]{4})"
    .ClearFormatting
    .Replacement.Font.Color = wdColorRed 'texte mis en rouge
    .Replacement.Text = madate$ 'remplace par la date entrée en InputBox
    .Forward = True
    .Wrap = wdFindContinue
    .MatchWildcards = True
    .Execute Replace:=wdReplaceAll
 
End With
End Sub

[Heureux-oli]

Salut,

On va essayer de trouver.

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
Sub Testoli()
Dim oFol As Scripting.Folder
Dim oFil As Scripting.File
Dim FSO As FileSystemObject
Dim oDoc As Document
Dim oTbl As Table
Dim inti As Integer
Dim oDl As FileDialog
 
Set FSO = New FileSystemObject
Set oDl = Application.FileDialog(msoFileDialogFolderPicker)
oDl.Show
Set oFol = FSO.GetFolder(oDl.SelectedItems(1))
 
 
 
Set oTbl = ActiveDocument.Tables(1)
 
'Boucle sur les documents
For Each oFil In oFol.Files
Debug.Print oFil.Name
Set oDoc = Documents.Open(oFil.Name)
oDoc.Select
'Boucle dans le document
For inti = 1 To oTbl.Rows.Count
With Selection.Find
 
    .Text = NetText(oTbl.Cell(inti, 1).Range.Text)
 
'Mon AJOUT*************
    .ClearFormatting
    With .Replacement
         .ClearFormatting
         .Font.Color = wdColorRed
    End With
'fin de Mon AJOUT*************
 
    .Replacement.Text = NetText(oTbl.Cell(inti, 2).Range.Text)
    .Forward = True
    .Execute Replace:=wdReplaceAll
    
End With
Next inti
oDoc.Save
oDoc.Close
Next oFil
 
Set oDoc = Nothing
Set FSO = Nothing
Set oFol = Nothing
Set oDl = Nothing
 
End Sub

Peux tu lancer la macro et nous donner les résultats que tu obtiens dans la fenêtre exécution.
Debug.print va afficher le contenu de la variable oFil.
Si tu n'as pas la fenêtre Exécution, dans le VBE, presse Ctrl + G

[rosemary_antoine]

Bon je viens de relancer:
Je suis sur l'ordi du boulot. J'ai de nouvelles erreurs
"erreur de compilation, sub ou function non défini"

Code :

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

    .Text = NetText(oTbl.Cell(inti, 1).Range.Text)

[Heureux-oli]

Salut,

Il manque dans ton code cette fonction :

Code :

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

1
2
3
4
Function NetText(stTemp As String) As String
NetText = Left(stTemp, Len(stTemp) - 2)
 
End Function

C'est la fonction qui renvoie le contenu de la cellule du tableau sans les caractères de fin de cellule.

[rosemary_antoine]

ok, Toujours la même erreur il plante sur le deuxième fichier. "erreur d'éxécution 5174 fichier introuvable c:\...\test2.doc"
Dans la fenètre d'exécution j'ai :

fichier test1.doc
fichier test2.doc

Le fichier test1 est bien traité et reste ouvert. Les autres ne sont pas traités

[Heureux-oli]

Salut,

Je viens de faire un test sur une autre machine et tout passe très bien.


Peux-tu faire un essai ?

Dans un document vierge, tu tapes =rand(10,10) suivi de entrée.
Sauvegardes ce même document sous trois noms différents dans le même répertoire (qui ne contiendra que ces fichiers).

Crées un nouveau document vierge.
Dans le VBE, colle l'intégralité de mon code.
Ajoutes la référence à Microsoft Scripting Runtime

dans ce nouveau document, ajoute un tableau avec quelques mots contenus dans les documents précédents pour obtenir un remplacement.

Lance la macro.

Dis moi ce qui se passe.