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 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115
| 'Recherche et remplacement d'une liste de mots
'===============================
'
Function NetText(stTemp As String) As String
'===========================================
'Fonction de nettoyage
'Supprime les deux caractères de fin de cellule
'
'NetText = Left(stTemp, Len(stTemp) - 2) 'Left(chaîne,nb_caractères à gauche)
'stTemp : variable de chaîne de caractère ?
'Len donne le nombre de caractères d'une chaîne (=nbcar() sur Excel)
NetText = Left(stTemp, Len(stTemp))'Remplace la ligne précédente, car pas besoin de supprimer les deux caractères de fin de cellule
End Function
'Nous l'utiliserons dans la procédure suivante pour obtenir les mots recherchés et les mots de remplacement.
'
Sub RemplacerListeDeMots()
'==================
'Cette macro a pour rôle de remplacer les mots d'un document par
'une liste de mots se trouvant dans une table à deux colonnes
'___________________________________________________
'
'Déclaration des variables correspondant aux fichiers
'----------------------------------------------------
'Le document oDocSource contient la liste des mots à chercher
'et le document oDocCible les mots à remplacer
Dim oDocSource As Document, oDocCible As Document
'
'Déclaration des variables Table
Dim oTbl As Table 'Définition de tableau
Dim oRow As Row 'Définition de ligne
'
'Une boîte de dialogue pour choisir les documents
Dim oDlg As FileDialog
'
'
'Dans un premier temps, nous allons ouvrir les deux documents, le premier contenant la liste des mots à rechercher
'(tableau à deux colonnes) et le second étant celui dans lequel nous souhaitons faire les remplacements.
'
'Pour ouvrir les documents, au lieu de les mettre en "dur" dans le code, nous allons utiliser un objet "FileDialog".
'Cet objet permet de sélectionner un répertoire ou un fichier. Dans notre exemple, nous allons l'utiliser pour les fichiers.
'Ce choix s'obtient par l'argument passé lors de l'affectation.
'
Set oDlg = Application.FileDialog(msoFileDialogFilePicker)
'
'
'Ouverture du premier document
'-----------------------------
'Ouverture de la boîte de dialogue
'Pour afficher cette boîte de dialogue, nous allons utiliser sa méthode ".Show".
'Comme il s'agit d'un échange avec l'utilisateur, nous avons la possibilité de choisir un titre pour la boîte de dialogue
'et nous n'avons besoin que d'un seul fichier.
With oDlg
.AllowMultiSelect = False
.Title = "Document contenant le tableau des mots avec exposant"
.Show 'Affichage de la boîte de dialogue. On demande à l'utilisateur
' qu'il désigne le fichier avec le tableau
End With
'Cet objet va renvoyer le nom du fichier choisi par l'utilisateur.
'Comme il n'y a qu'un seul fichier, nous récupérons le premier élément.
'
'La propriété SelectedItems contient :
Set oDocSource = Documents.Open(oDlg.SelectedItems(1)) 'Il n'est pas nécessaire
' de passer par une variable, nous pouvons directement utiliser
' le résultat de oDlg.SelectedItems(1)en argument.
'
'Il faut répéter l'opération une seconde fois pour le document cible
'On affiche à nouveau la boîte de dialogue pour que l'utilisateur donne
'le nom du fichier cible
With oDlg
.AllowMultiSelect = False
.Title = "Document cible avec les occurrences à remplacer"
.Show 'Affichage de la boîte de dialogue. On demande à l'utilisateur
' qu'il désigne le fichier cible où seront effectués les remplacements
End With
'
'L'objet oDlg va renvoyer le nom du fichier choisi par l'utilisateur.
'Comme il n'y a qu'un seul fichier, nous récupérons le premier élément :
'Choix du fichier : oDlg.SelectedItems(1)
'
'Ouverture du second document : Document cible avec les occurrences à remplacer
Set oDocCible = Documents.Open(oDlg.SelectedItems(1))
'
'
'Création de la boucle sur les éléments du tableau
'Boucle sur les éléments du tableau qui seront utilisés pour la recherche et le remplacement.
'On affecte le premier tableau du document source à la variable tableau pour ensuite faire une boucle sur les lignes du tableau.
'Dans notre cas, c'est assez simple, la première colonne contient le mot à rechercher et la seconde, le mot de remplacement.
'
'Affectation de la table
Set oTbl = oDocSource.Tables(1) 'On affecte le tableau du document source à la
'variable oTbl pour ensuite faire une boucle sur les
'lignes du tableau
'Boucle sur les cellules de la table
For Each oRow In oTbl.Rows 'Pour chaque ligne des lignes du tableau...
oDocCible.Select 'Sélection du document cible
Selection.HomeKey unit:=wdStory 'La recherche démarre au début du document
'Dans cette boucle, nous utilisons directement le résultat dans notre fonction de recherche et remplacement.
With Selection.Find
' .ClearFormatting 'Ne pas tenir compte des formats dans le remplacement
' Ligne neutralisée afin de ne pas agir sur le format exposant lors du remplacement
.Forward = True
.Text = NetText(oRow.Cells(1).Range.Text) 'Utilisation de la fonction de nettoyage
.Replacement.Text = NetText(oRow.Cells(2).Range.Text) 'Utilisation de la fonction de nettoyage
' .Replacement.ClearFormatting 'Remise à zéro des paramètres de format de la fenêtre rechercher remplacer
' Ligne neutralisée afin de ne pas agir sur le format exposant lors du remplacement
.Execute Replace:=wdReplaceAll 'Exécution de remplacer tout
End With
'
Next oRow 'La boucle continue le traitement sur la ligne suivante
'Libération des objets
Set oDlg = Nothing
Set oTbl = Nothing
oDocSource.Close savechanges:=wdDoNotSaveChanges 'Fermeture du fichier du tableau sans enregistrer
Set oDocSource = Nothing
End Sub |
Partager