Pour s'affranchir de la boîte "Insertion | Renvoi..." peu pratique de Word, cette macro permet de transformer le texte sélectionné (par ex. "3.2.2" ou "[2]") en renvoi cliquable vers l'élément numéroté ou le signet correspondant.
Source / Exemple :
Sub textToReference()
' Converti un texte sélectionné représentant un numéro de paragraphe en renvoi vers ce paragraphe,
' ou bien un texte représentant le texte d'un signet (indépendamment de son nom) en renvoi vers ce signet.
Dim refToLookup As String
Dim numberedItems() As String, strItem As String
Dim iItem As Integer, iFound As Integer
Dim strFound As String
iFound = -1
refToLookup = Trim(Selection.Text)
' Récupère les éléments numérotés
numberedItems = ActiveDocument.GetCrossReferenceItems(wdRefTypeHeading)
For iItem = LBound(numberedItems) To UBound(numberedItems)
strItem = Trim(numberedItems(iItem))
If (Len(strItem) >= Len(refToLookup)) Then
If (StrComp(refToLookup, Left(strItem, Len(refToLookup)), vbTextCompare) = 0) Then
iFound = iItem
strFound = numberedItems(iItem)
Exit For
End If
End If
Next iItem
If (iFound > 0) Then
' Insertion d'un élément numéroté
Selection.InsertCrossReference ReferenceType:=wdRefTypeHeading, _
ReferenceKind:=wdNumberFullContext, ReferenceItem:=CStr(iFound), _
InsertAsHyperlink:=True, IncludePosition:=False
Else
' Non trouvé dans les éléments numérotés : parcours les signets
' Récupère les signets
numberedItems = ActiveDocument.GetCrossReferenceItems(wdRefTypeBookmark)
Dim strBookmarkText As String
For iItem = LBound(numberedItems) To UBound(numberedItems)
strItem = Trim(numberedItems(iItem))
strBookmarkText = ActiveDocument.Bookmarks(strItem).Range.Text
If (Len(strBookmarkText) >= Len(refToLookup)) Then
If (StrComp(refToLookup, Left(strBookmarkText, Len(refToLookup)), vbTextCompare) = 0) Then
iFound = iItem
strFound = strItem
Exit For
End If
End If
Next iItem
If (iFound > 0) Then
' Insertion d'un signet
Selection.InsertCrossReference ReferenceType:=wdRefTypeBookmark, _
ReferenceKind:=wdContentText, ReferenceItem:=strFound, _
InsertAsHyperlink:=True, IncludePosition:=False
End If
End If
If (iFound < 0) Then
Call MsgBox("Aucun élement numéroté ni aucun signet """ & refToLookup & """ n'a été trouvé dans le document.", vbExclamation + vbOKOnly)
Exit Sub
End If
End Sub
Conclusion :
Associez cette macro à un raccourci clavier pratique, tapez juste le numéro de paragraphe ou texte du signet, sélectionnez-le, Ctrl-Machin, et zou, un renvoi de fait !
Vous n'êtes pas encore membre ?
inscrivez-vous, c'est gratuit et ça prend moins d'une minute !
Les membres obtiennent plus de réponses que les utilisateurs anonymes.
Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.
Le fait d'être membre vous permet d'avoir des options supplémentaires.