-
I have multiple headings in a document as a scheme that goes like this: heading 1 is Section 1, heading 2 is 1.1, and heading 3 is 1.1(a). Throughout the document, there are references like, please see Section 2.2(c). Instead of going into the insert cross reference each time and find the heading and select it to make a hyperlinked cross reference, I want to do it automatically. I would like it to do the whole document at once, but so far I can only make a code that does it one by one and you have to select it first. It also doesn't pick up anything with a letter, so it won't catch 2.2(c).
Do you know how to fix this so it does the letter subheadings as well?
Code:
Sub InsertCrossRef()
Dim RefList As Variant
Dim LookUp As String
Dim Ref As String
Dim s As Integer, t As Integer
Dim i As Integer
On Error GoTo ErrExit
With Selection.Range
' discard leading blank spaces
Do While (Asc(.Text) = 32) And (.End > .Start)
.MoveStart wdCharacter
Loop
' discard trailing blank spaces, full stops and CRs
Do While ((Asc(Right(.Text, 1)) = 46) Or _
(Asc(Right(.Text, 1)) = 32) Or _
(Asc(Right(.Text, 1)) = 11) Or _
(Asc(Right(.Text, 1)) = 13)) And _
(.End > .Start)
.MoveEnd wdCharacter, -1
Loop
ErrExit:
If Len(.Text) = 0 Then
MsgBox "Please select a reference.", _
vbExclamation, "Invalid selection"
Exit Sub
End If
LookUp = .Text
End With
On Error GoTo 0
With ActiveDocument
' Use WdRefTypeHeading to retrieve Headings
RefList = .GetCrossReferenceItems(wdRefTypeNumberedItem)
For i = UBound(RefList) To 1 Step -1
Ref = Trim(RefList(i))
If InStr(1, Ref, LookUp, vbTextCompare) = 1 Then
s = InStr(2, Ref, " ")
t = InStr(2, Ref, Chr(9))
If (s = 0) Or (t = 0) Then
s = IIf(s > 0, s, t)
Else
s = IIf(s < t, s, t)
End If
If LookUp = Left(Ref, s - 1) Then Exit For
End If
Next i
If i Then
Selection.InsertCrossReference ReferenceType:="Numbered item", _
ReferenceKind:=wdNumberFullContext, _
ReferenceItem:=CStr(i), _
InsertAsHyperLink:=True, _
IncludePosition:=False, _
SeparateNumbers:=False, _
SeparatorString:=" "
Else
MsgBox "A cross reference to """ & LookUp & """ couldn't be set" & vbCr & _
"because a paragraph with that number couldn't" & vbCr & _
"be found in the document.", _
vbInformation, "Invalid cross reference"
End If
End With
End Sub
-
We discussed this previously in VBA to automatically mark cross-reference (vbaexpress.com). Please continue the discussion there. Thread closed.
