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

 

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