Remplacer du texte dans plusieurs documents Word - VB/VBA/VBS - Programmation
MarshPosté le 30-01-2004 à 16:06:57
Bonjour,
Suite à un changement de nom de notre société, je dois mettre à jour tous les documents de référence (environ 500) en changeant un texte par un autre. J'ai trouvé cette macro sur le net qui fonctionne très bien, cependant, le texte recherché et sélectionné puis remplacé doit se situer dans le corps du texte. Or, dans mon cas, le texte se situe dans les en-tête et pied de page de ces documents.
Est-ce que quelqu'un de calé en Visual Basic pour Word pourrait m'aider à modifier cette macro afin que l'en-tête de page soit sélectionné avant d'effectuer la recherche de texte ?
Par avance, merci.
Voici mon code (3 procédures) :
Citation :
Sub ScanDossier() On Error Resume Next Dim sh, f, fold Set sh = CreateObject("Shell.Application" ) Set f = sh.BrowseForFolder(0, "", 592) fold = f.Items.Item.Path If Err.Number <> 0 Then Exit Sub TraiteDossier fold End Sub
Sub TraiteDossier(fold) Dim f, fs Set fs = CreateObject("Scripting.FileSystemObject" ) For Each f In fs.getFolder(fold).Files If Right(f.Name, 4) = ".doc" Then traiteFic (f) Next For Each f In fs.getFolder(fold).Subfolders TraiteDossier f.fullpath Next End Sub
Sub traiteFic(f) Documents.Open FileName:=f With Selection.Find .Text = "Ancien-Nom" .Replacement.Text = "Nouveau-Nom" End With Selection.Find.Execute Replace:=wdReplaceAll ActiveDocument.Close wdSaveChanges End Sub
Marsh Posté le 30-01-2004 à 16:06:57
Bonjour,
Suite à un changement de nom de notre société, je dois mettre à jour tous les documents de référence (environ 500) en changeant un texte par un autre.
J'ai trouvé cette macro sur le net qui fonctionne très bien, cependant, le texte recherché et sélectionné puis remplacé doit se situer dans le corps du texte. Or, dans mon cas, le texte se situe dans les en-tête et pied de page de ces documents.
Est-ce que quelqu'un de calé en Visual Basic pour Word pourrait m'aider à modifier cette macro afin que l'en-tête de page soit sélectionné avant d'effectuer la recherche de texte ?
Par avance, merci.
Voici mon code (3 procédures) :
Sub ScanDossier()
On Error Resume Next
Dim sh, f, fold
Set sh = CreateObject("Shell.Application" )
Set f = sh.BrowseForFolder(0, "", 592)
fold = f.Items.Item.Path
If Err.Number <> 0 Then Exit Sub
TraiteDossier fold
End Sub
Sub TraiteDossier(fold)
Dim f, fs
Set fs = CreateObject("Scripting.FileSystemObject" )
For Each f In fs.getFolder(fold).Files
If Right(f.Name, 4) = ".doc" Then traiteFic (f)
Next
For Each f In fs.getFolder(fold).Subfolders
TraiteDossier f.fullpath
Next
End Sub
Sub traiteFic(f)
Documents.Open FileName:=f
With Selection.Find
.Text = "Ancien-Nom"
.Replacement.Text = "Nouveau-Nom"
End With
Selection.Find.Execute Replace:=wdReplaceAll
ActiveDocument.Close wdSaveChanges
End Sub
Par avance, merci !