Est-il possible d'attribuer un style spécifique à toutes les références croisées dans Word 2007 ?

• Appuyez sur Alt+F9 pour afficher les codes de champ

• Utilisez la macro suivante pour ajouter CHARFORMAT à toutes les références croisées. Cette macro ajoute la chaîne au champ uniquement si elle n'est pas déjà présente.

  Sub SetCHARFORMAT()
  '
  ' Définir l'interrupteur CHARFORMAT pour tous les champs {REF}. Remplacer MERGEFORMAT.
  '
  '
      Dim oField As Field
      Dim oRng As Range
      For Each oField In ActiveDocument.Fields
      'For Each oField In Selection.Fields
          If InStr(1, oField.Code, "REF ") = 2 Then
              If InStr(1, oField.Code, "MERGEFORMAT") <> 0 Then
                  oField.Code.Text = Replace(oField.Code.Text, "MERGEFORMAT", "CHARFORMAT")
              End If
              If InStr(1, oField.Code, "CHARFORMAT") = 0 Then
                  oField.Code.Text = oField.Code.Text + "\* CHARFORMAT "
              End If
          End If
      Next oField
  
  End Sub

• Utilisez cette macro pour formater toutes les références croisées avec le style "Référence subtile" (assurez-vous d'avoir un tel style, et que les codes de champ sont affichés) :

  Sub SetCrossRefStyle()
  '
  ' Macro pour définir le style de toutes les références croisées sur "Référence subtile"
  '
  '
      Selection.Find.ClearFormatting
      Selection.Find.Replacement.ClearFormatting
      Selection.Find.Replacement.Style = ActiveDocument.Styles( _
          "Référence subtile")
      With Selection.Find
          .Text = "^19 REF"
          .Replacement.Text = ""
          .Forward = True
          .Wrap = wdFindContinue
          .Format = True
          .MatchCase = False
          .MatchWholeWord = False
          .MatchKashida = False
          .MatchDiacritics = False
          .MatchAlefHamza = False
          .MatchControl = False
          .MatchWildcards = False
          .MatchSoundsLike = False
          .MatchAllWordForms = False
      End With
      Selection.Find.Execute Replace:=wdReplaceAll
  End Sub

• Appuyez sur Alt+F9 pour masquer les codes de champ

En éditant la macro téléchargée par le cyborg, nous pouvons facilement automatiser l'affichage et la masquage des codes de champ. Ainsi, chaque fois que nous souhaitons mettre à jour, nous n'avons pas à utiliser le basculement des codes de champ. J'ai utilisé le code suivant pour ajouter un basculement de code de champ.

ActiveDocument.ActiveWindow.View.ShowFieldCodes = False

La macro complète est la suivante:

Sub SetCrossRefStyle()
'
' Macro pour définir le style de toutes les références croisées sur "Subtle Reference"
'
'
ActiveDocument.ActiveWindow.View.ShowFieldCodes = True
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
Selection.Find.Replacement.Style = ActiveDocument.Styles( _
    "Subtle Reference")
With Selection.Find
    .Text = "^19 REF"
    .Replacement.Text = ""
    .Forward = True
    .Wrap = wdFindContinue
    .Format = True
    .MatchCase = False
    .MatchWholeWord = False
    .MatchKashida = False
    .MatchDiacritics = False
    .MatchAlefHamza = False
    .MatchControl = False
    .MatchWildcards = False
    .MatchSoundsLike = False
    .MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
ActiveDocument.ActiveWindow.View.ShowFieldCodes = False
End Sub

C'est la première fois que j'utilise des macros pour accélérer mon travail dans Word. Merci cyborg pour une macro si utile.

Cette macro ouvre la boîte de dialogue Référence Croisée pour insérer une référence croisée à la position actuelle du curseur.

Lorsque vous fermez la boîte de dialogue Xref après avoir inséré la référence, la macro reprend pour formater la référence croisée insérée en exposant.

Sub XrefSuper()
'
' Cela ouvre la boîte de dialogue Référence Croisée pour insérer une référence croisée à la position actuelle du curseur.
'   Lorsque la boîte de dialogue est fermée après avoir inséré la référence, la macro reprend pour formater la référence croisée insérée en exposant.
'
'
Dim wc As Integer
    wc = ActiveDocument.Characters.Count

Dim dlg As Dialog
    Set dlg = Dialogs(wdDialogInsertCrossReference)
        dlg.Show 'Ouvrir la boîte de dialogue et effectuer l'insertion depuis la boîte de dialogue) 
                 'La macro continue après la fermeture de la boîte de dialogue CrossRef

    If wc = ActiveDocument.Characters.Count Then Exit Sub   'Si nous n'avons pas réussi à insérer quelque chose, alors sortir

    Selection.MoveLeft Unit:=wdCharacter, Count:=1, Extend:=wdExtend
    Selection.Font.Superscript = wdToggle
    Selection.MoveRight Unit:=wdCharacter, Count:=1
    Selection.Font.Superscript = wdToggle
End Sub

Merci à Graham Skan chez ExpertsExchange pour la façon d'ouvrir la boîte de dialogue Xref.

Combinant les réponses ci-dessus avec une autre fonction pour parcourir les 'histoires' du document, afin d'appliquer des styles sur le corps du document, les en-têtes, les pieds de page et le texte sur les formes.

Il suffit d'appeler la macro SetCrossRefStyle() ci-dessous pour appliquer le style "Référence intense" à toutes les références croisées.

Sub m_SetCHARFORMAT(textRanges As Collection)
' https://superuser.com/questions/13531/is-it-possible-to-assign-a-specific-style-to-all-cross-references-in-word-2007
'
' Définir l'interrupteur CHARFORMAT pour tous les champs {REF}. Remplacer MERGEFORMAT.
' Nécessite ActiveDocument.ActiveWindow.View.ShowFieldCodes = True
'
    Dim oField As Field
    Dim oRng As Range
    For Each oRng In textRanges
        For Each oField In oRng.Fields
            If InStr(1, oField.Code, "REF ") = 2 Then
                If InStr(1, oField.Code, "MERGEFORMAT") <> 0 Then
                    oField.Code.Text = Replace(oField.Code.Text, "MERGEFORMAT", "CHARFORMAT")
                End If
                If InStr(1, oField.Code, "CHARFORMAT") = 0 Then
                    oField.Code.Text = oField.Code.Text + "\* CHARFORMAT "
                End If
            End If
        Next oField
    Next oRng
End Sub

Sub m_AddCrossRefStyle(textRanges As Collection)
' https://superuser.com/questions/13531/is-it-possible-to-assign-a-specific-style-to-all-cross-references-in-word-2007
'
' Macro pour définir le style de toutes les références croisées sur "Référence intense"
' Nécessite ActiveDocument.ActiveWindow.View.ShowFieldCodes = True
'
    For Each oRng In textRanges
        oRng.Find.ClearFormatting
        oRng.Find.Replacement.ClearFormatting
        oRng.Find.Replacement.Style = ActiveDocument.Styles("Intense Reference")
        With oRng.Find
            .Text = "^19 REF"
            .Replacement.Text = ""
            .Forward = True
            .Wrap = wdFindContinue
            .Format = True
            .MatchCase = False
            .MatchWholeWord = False
            .MatchKashida = False
            .MatchDiacritics = False
            .MatchAlefHamza = False
            .MatchControl = False
            .MatchWildcards = False
            .MatchSoundsLike = False
            .MatchAllWordForms = False
        End With
        oRng.Find.Execute Replace:=wdReplaceAll
    Next oRng
End Sub

Function m_GetAllTextRanges() As Collection
' https://wordmvp.com/FAQs/Customization/ReplaceAnywhere.htm
' https://www.mrexcel.com/forum/excel-questions/443052-returning-collection-function.html
'
' Obtenez des plages de texte dans toutes les parties du document.
'
    Set m_GetAllTextRanges = New Collection
    For Each rngStory In ActiveDocument.StoryRanges
        'Itérer à travers toutes les histoires liées
        Do
            m_GetAllTextRanges.Add rngStory
            On Error Resume Next
            Select Case rngStory.StoryType
                Case 6, 7, 8, 9, 10, 11
                If rngStory.ShapeRange.Count > 0 Then
                    For Each oShp In rngStory.ShapeRange
                        If oShp.TextFrame.HasText Then
                            m_GetAllTextRanges.Add oShp.TextFrame.TextRange
                        End If
                    Next
                End If
                Case Else
                    'Ne rien faire
            End Select
            On Error GoTo 0
            'Obtenir l'histoire liée suivante (le cas échéant)
            Set rngStory = rngStory.NextStoryRange
        Loop Until rngStory Is Nothing
    Next
End Function

Sub SetCrossRefStyle()
'
' 1. Obtenir toutes les plages de texte car la méthode Selection.Find ne fonctionne que sur le corps du document, mais pas sur les en-têtes/pieds de page
' 2. Ajouter CHARFORMAT pour rendre le style persistant
' 3. Ajouter du style à toutes les références
'
    Dim textRanges As Collection
    Set textRanges = m_GetAllTextRanges
    ActiveDocument.ActiveWindow.View.ShowFieldCodes = True
    m_SetCHARFORMAT textRanges
    m_AddCrossRefStyle textRanges
    ActiveDocument.ActiveWindow.View.ShowFieldCodes = False
End Sub