MS Word - link to header of current section / relative referencing - vba

Question

I'm working on a largeish document with multi-level headings, for a long set of test procedures. At the end of each procedure, there is a sign-off box. I want to add the section number and name to each sign-off box.
I researched (here, of course!) and wrote a macro to insert a reference to the heading of the current section, it appears to work fine:
Sub InsertCrossRefToSectionHeading()
Dim RefList As Variant
Dim LookUp As String
Dim Ref As String
Dim i As Integer
LookUp = ActiveDocument.Bookmarks("\HeadingLevel").Range.Paragraphs(1).Range.ListFormat.ListString
With ActiveDocument
RefList = .GetCrossReferenceItems(wdRefTypeHeading)
For i = UBound(RefList) To 1 Step -1
Ref = Trim(RefList(i))
If Left(Ref, Len(LookUp)) = LookUp Then Exit For
Next i
If i Then
Selection.InsertCrossReference ReferenceType:=wdRefTypeHeading, _
ReferenceKind:=wdNumberFullContext, _
ReferenceItem:=CStr(i), _
InsertAsHyperlink:=True, _
IncludePosition:=False, _
SeparateNumbers:=False, _
SeparatorString:=" "
Selection.TypeText Text:=vbTab
Selection.InsertCrossReference ReferenceType:=wdRefTypeHeading, _
ReferenceKind:=wdContentText, _
ReferenceItem:=CStr(i), _
InsertAsHyperlink:=True, _
IncludePosition:=False, _
SeparateNumbers:=False, _
SeparatorString:=" "
'Copy the formatting from the previous cell in the template table and apply to refrence text.
Selection.MoveLeft Unit:=wdCell
Selection.CopyFormat
Selection.MoveRight Unit:=wdCell
Selection.PasteFormat
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
However, it is a hard-linked reference to the heading that was the heading for this section at the time of running the macro. If I add a section, all references in the sign-off boxes after that section are pointing at the previous section, and it defeats the purpose of it.
Yes, my macro will make it much quicker to fix, but there will be a lot of rework every time I add a section to this evolving document. And yes, I could possibly even programmatically search the document for tables with "Test Record" in the top row, then delete Row 2 Cell 2 and insert the reference... but that's a lot of extra programming!... I've done a ton of VBA in Excel, but am new to it in Word. I guess I could leave the references until the very end... of this edit - but then I'll have to do it all again if the doc evolves in the future (which is very likely).
Is there any way to reference the heading of the current section?
Thanks for your help!

Answer 1

Thanks to #CharlesKenyon, here's the solution (much simpler than my first attempt too!).
Sub InsertCrossRefToSectionHeading()
' Adds ref to the heading of the current section.
'https://stackoverflow.com/questions/67200486/ms-word-link-to-header-of-current-section-relative-referencing
'http://www.addbalance.com/usersguide/fields.htm#STYLEREF
CurrentHeadingLevel = ActiveDocument.Bookmarks("\HeadingLevel").Range.Paragraphs(1).Range.ListFormat.ListLevelNumber
Selection.Fields.Add Range:=Selection.Range, Type:=wdFieldEmpty, Text:= _
"STYLEREF ""Heading " & CurrentHeadingLevel & """ \w ", PreserveFormatting:=True
Selection.TypeText Text:=" "
Selection.Fields.Add Range:=Selection.Range, Type:=wdFieldEmpty, Text:= _
"STYLEREF ""Heading " & CurrentHeadingLevel & """ ", PreserveFormatting:=True
'Copy the formatting from the previous cell in the template table and apply to refrence text.
Selection.MoveLeft Unit:=wdCell
Selection.CopyFormat
Selection.MoveRight Unit:=wdCell
Selection.PasteFormat
End Sub