Rechercher et remplacer une chaine dans Word
Modifié par Francis Longhitano le 2012/04/03 12:17
Ce code permet de rechercher une chaine dans un document Word et de la remplacer par une autre.
En entrée de la fonction : 3 paramètres - L'emplacement et le nom du fichier Word , la chaine à rechercher , la chaine de remplacement.
Le programme fait appel à une fonction VBScript pour réaliser le remplacement.
DECL
ALPHA(2) RESULT /* Valeur en retour
NUM_BIN_4 NbElts
NUM_BIN_4 CodeRetour
NUM_BIN_4 Indice
NUM_BIN_4 Wlg_Chaine
ALPHA(512) W_DOC
ALPHA(100) W_FIND
ALPHA(100) W_RPL
NUM_BIN_4 NbElts
NUM_BIN_4 CodeRetour
NUM_BIN_4 Indice
NUM_BIN_4 Wlg_Chaine
ALPHA(512) W_DOC
ALPHA(100) W_FIND
ALPHA(100) W_RPL
INIT_PGM
CHARGER_DLL 'VaToCom'
W_DOC = 'C:\MON_DOCUMENT.docx'
W_FIND = 'document'
W_RPL = 'feuille'
* Initialisation de la DLL (un seul appel est utile)
APPELER_DLL 'VaToCom' 'Initialize' CodeRetour
* Chargement du script
APPELER_DLL 'VaToCom' 'AddScript' 'WordReplace.vbs' CodeRetour
* Indication du nombre de paramètres d’entrée
APPELER_DLL 'VaToCom' 'CreateParameters' 3 CodeRetour
* Remplissage des paramètres d’entrée
APPELER_DLL 'VaToCom' 'SetStringParameter' 0 W_DOC CodeRetour
APPELER_DLL 'VaToCom' 'SetStringParameter' 1 W_FIND CodeRetour
APPELER_DLL 'VaToCom' 'SetStringParameter' 2 W_RPL CodeRetour
* Exécution d’une fonction contenue dans le script
APPELER_DLL 'VaToCom' 'Execute' 'replacestring' CodeRetour
* Récupération de la taille du tableau global
APPELER_DLL 'VaToCom' 'GetParameterSize' -1 NbElts CodeRetour
* Récupération des éléments du tableau
Indice = 0
TANT_QUE Indice < NbElts
* Récupération élément du tableau
Wlg_Chaine = 2
APPELER_DLL 'VaToCom' 'GetStringParameter' Indice 0 RESULT Wlg_Chaine CodeRetour
Indice = Indice + 1
REFAIRE
' RESULT doit avoir la valeur 'OK'
DECHARGER_DLL 'VaToCom'
TERMINER
W_DOC = 'C:\MON_DOCUMENT.docx'
W_FIND = 'document'
W_RPL = 'feuille'
* Initialisation de la DLL (un seul appel est utile)
APPELER_DLL 'VaToCom' 'Initialize' CodeRetour
* Chargement du script
APPELER_DLL 'VaToCom' 'AddScript' 'WordReplace.vbs' CodeRetour
* Indication du nombre de paramètres d’entrée
APPELER_DLL 'VaToCom' 'CreateParameters' 3 CodeRetour
* Remplissage des paramètres d’entrée
APPELER_DLL 'VaToCom' 'SetStringParameter' 0 W_DOC CodeRetour
APPELER_DLL 'VaToCom' 'SetStringParameter' 1 W_FIND CodeRetour
APPELER_DLL 'VaToCom' 'SetStringParameter' 2 W_RPL CodeRetour
* Exécution d’une fonction contenue dans le script
APPELER_DLL 'VaToCom' 'Execute' 'replacestring' CodeRetour
* Récupération de la taille du tableau global
APPELER_DLL 'VaToCom' 'GetParameterSize' -1 NbElts CodeRetour
* Récupération des éléments du tableau
Indice = 0
TANT_QUE Indice < NbElts
* Récupération élément du tableau
Wlg_Chaine = 2
APPELER_DLL 'VaToCom' 'GetStringParameter' Indice 0 RESULT Wlg_Chaine CodeRetour
Indice = Indice + 1
REFAIRE
' RESULT doit avoir la valeur 'OK'
DECHARGER_DLL 'VaToCom'
TERMINER
Le fichier vbs doit être positionné avec les objets "client" afin de pouvoir être appelé par le programme.
WordReplace.vbs
'*********************************************************************
'
' HARDIS - Replace a string in a Word document - 2012
'
'*********************************************************************
'
Option Explicit
'
'*********************************************************************
'
'
'*********************************************************************
Dim WordApp
Dim WordDoc
Dim strCompare
Dim strReplace
Dim coderetour
' La ligne ci-dessous permet de faire un test avec un document existant
' coderetour = replacestring("C:\MON_DOCUMENT.docx" , "document" , "feuille")
'
Public Function replacestring(nomdoc, chainefind, chainereplace)
'
replacestring = "KO"
'
Set WordApp = CreateObject("Word.Application")
WordApp.Visible = False
Set WordDoc = WordApp.Documents.Open(nomdoc)
strCompare = chainefind
strReplace = chainereplace
'
With WordApp.Selection.Find
.ClearFormatting
.Replacement.ClearFormatting
.Forward = True
.MatchWholeWord = False
.Wrap = 1
.Text = strCompare
.Execute ,,,,,,,,,strReplace,2
End With
'
WordDoc.Save
WordApp.Quit
'
Set WordDoc = Nothing
Set WordApp = Nothing
' retourne ok
replacestring = "OK"
Exit Function
End Function
'
' HARDIS - Replace a string in a Word document - 2012
'
'*********************************************************************
'
Option Explicit
'
'*********************************************************************
'
'
'*********************************************************************
Dim WordApp
Dim WordDoc
Dim strCompare
Dim strReplace
Dim coderetour
' La ligne ci-dessous permet de faire un test avec un document existant
' coderetour = replacestring("C:\MON_DOCUMENT.docx" , "document" , "feuille")
'
Public Function replacestring(nomdoc, chainefind, chainereplace)
'
replacestring = "KO"
'
Set WordApp = CreateObject("Word.Application")
WordApp.Visible = False
Set WordDoc = WordApp.Documents.Open(nomdoc)
strCompare = chainefind
strReplace = chainereplace
'
With WordApp.Selection.Find
.ClearFormatting
.Replacement.ClearFormatting
.Forward = True
.MatchWholeWord = False
.Wrap = 1
.Text = strCompare
.Execute ,,,,,,,,,strReplace,2
End With
'
WordDoc.Save
WordApp.Quit
'
Set WordDoc = Nothing
Set WordApp = Nothing
' retourne ok
replacestring = "OK"
Exit Function
End Function