Help with Cross References Macro

Question

I cobbled together two macros from various sources.

The first one [InsertFigRef] brings up the cross reference dialogue box with my preferred settings already selected (Reference Type: "Fig.", Insert Reference to: "Lable and Number Only", Insert as hyperlink). When I close the dialogue box it then runs a second macro [ChangeFieldContent2] which applies a 'CrossRef' character style to the references.

Predictably as I've added more and more cross references it's gotten slower and slower since the macro which applies the CrossRef style loops through all of them each time. Is there a way to have a single macro open the cross reference dialogue box with my preferred settings and then apply the crossref character style to the cross reference it inserts?

Here are the macro's I'm using at the moment.

Sub InsertFigRef()

Dim i As Integer

With Dialogs(wdDialogInsertCrossReference)

 For i = 1 To 11

 SendKeys "{DOWN}"

 Next

 SendKeys "{END}{UP}{UP}{UP}{TAB}:"

 For i = 1 To 5

 SendKeys "{UP}"

 Next

 SendKeys "{DOWN}{TAB}{TAB} %h": .Show

End With

Application.Run "ChangeFieldContent2"

End Sub

Sub ChangeFieldContent2()

Dim strCodes As String

Dim iFld As Integer

Dim strFind As String

Dim strRepl As String

Selection.HomeKey

For iFld = ActiveDocument.Fields.Count To 1 Step -1

With ActiveDocument.Fields(iFld)

If .Type = wdFieldRef Then

If InStr(1, UCase(.Code), "MERGEFORMAT") = 0 Then

.Code.Text = Replace(.Code.Text, _

"MERGEFORMAT", "CHARFORMAT")

End If

If InStr(1, UCase(.Code), "CHARFORMAT") = 0 Then

.Code.Text = .Code.Text & " \* CHARFORMAT "

End If

.Code.Style = "CrossRef"

.Update

End If

End With

Next iFld

End Sub

Answer 1

Your macro inserts and formats a cross reference to an endnote? e.g.

{ PAGEREF _Ref297715504 \p \h  \* CHARFORMAT }

If as your question indicates you want to insert a reference to a Figure

{ REF _Ref297716129 \h  \* CHARFORMAT }

then I guess you will need

Sub InsertFigRef()

Dim i As Long

Dim oRng As Range

Dim oFld As Range

Set oRng = Selection.Range

ActiveWindow.View.ShowFieldCodes = False

With Dialogs(wdDialogInsertCrossReference)

    SendKeys " {HOME}{DOWN 6}{TAB} {HOME}{DOWN}{TAB 3}%(h)"

    .Show

End With

On Error Resume Next

oRng.MoveEnd wdWord, 1

With oRng.Fields(1)

    If Err.Number = 5941 Then Exit Sub

    .Code.Text = .Code.Text & " \* CHARFORMAT "

    .Update

End With

oRng.Style = "CrossRef"

End Sub

The part of your code about Mergeformat is unnecessary as the reference tool does not add the mergeformat switch, so you can simply add a charformat switch. CrossRef will have to be a character style.

Check the sendkeys statement to ensure that it does choose the options you really want

Answer 2

Thanks, that works perfectly.