Il y a quelques temps je publiais un article intitulé “Word : afficher une info-bulle contenant la définition d’un mot au survol de la souris en utilisant le champ AUTOTEXTLIST” dans cette article j’explique comment ajouter dans Word une info-bulle à un mot permettant de l’expliquer ou de le définir. Suite à cette article un Internaute m’a demandé de lui fournir une macro qui permettrait d’automatiser cette tâche.
Je vous présente donc “InfoBulle” une macro qui recherche l’occurrence d’un mot dans un document puis le remplace par un champ permettant d’afficher lorsque vous survolez le mot avec la souris une info-bulle qui contient un texte pouvant être utilisé pour définir ou expliquer le mot survolé. Cette macro a été fait sous Word version 2010.
La macro ‘Infobulle’
Sub InfoBulle()
'
' Macro Info-bulle, créée par Mehdi HAMMADI le 15/03/2012
' Suite à la requête d'un Internaute sur le site Office Users
' Objectif rechercher les différentes occurrences d'un mot dans un texte puis lui ajouter une infobulle.
' Merci à Circé pour la partie de code permettant de compté le nombre d'occurence d'un mot
’ (http://www.faqword.com/index.php/word/faq-word/vba-solutions/555-comment-compter-le-nombre-doccurences-contenues-dans-un-document)
Dim strMotARecherche As String
Dim strTexteInfoBulle As String
Dim strTexteDuChamp As String
strMotARechercher = InputBox("Saisissez le mot", "Mot à rechercher")
strTexteInfoBulle = InputBox("Saisissez le texte de l'info-bulle", "Info-bulle")
If IsNull(strMotARechercher) Or strMotARechercher = "" Or IsNull(strTexteInfoBulle) _
Or strTexteInfoBulle = "" Then
Exit Sub
Else
Selection.HomeKey Unit:=wdStory
strTexteDuChamp = "AUTOTEXTLIST " & chr$(34) & strMotARechercher & chr$(34) & " \t " _
& chr$(34) & strTexteInfoBulle & chr$(34)
iCount = 0
With ActiveDocument.Content.Find
Do While .Execute(FindText:=strMotARechercher, Format:=False, _
MatchCase:=False, MatchWholeWord:=True) = True
iCount = iCount + 1
Loop
End With
If iCount = 0 Then
MsgBox ("pas de correspondance")
Exit Sub
End If
Selection.HomeKey Unit:=wdStory
With Selection.Find
.Text = strMotARechercher
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = True
End With
For i = 1 To iCount
Selection.Find.Execute
ActiveWindow.View.ShowFieldCodes = True
Selection.Fields.Add Range:=Selection.Range, Type:=wdFieldEmpty, _
Text:=strTexteDuChamp, PreserveFormatting:=True
ActiveWindow.View.ShowFieldCodes = False
Next
End If
End Sub
