Jump to a numbered item with default heading and custom heading

hank1234 · #1 12-26-2022, 02:33 PM

I have writted the VBA code stated below (based on the code that I found here.

The problem is in a nutshell:

1) the code first looks in a legal document for numbered items with heading 1, heading 2, etc. For example: '1.2' or '12.1'. For this search, I use 'wdRefTypeHeading'. This part of the code works well as long as the numbering in the specific Word document uses the default headings. In that case the cursor jumps to the specific numbered paragraph starting with the specific number ('1.2' for instance);

2) if the search does not find the 'item number' at part 1 ('default headings'), the code searches within the 'custom headings' with 'wdRefTypeCustomHeading'. Many law firms use their own style/headings ('DB Heading 2' or 'PRFD Heading 1'). In the debug.print, I can see that the correct paragraph is found. Unfortunately, the bookmark is not inserted at the beginning of the relevant paragraph, but elsewhere in the document (to me it seems to be a random place);

3) if both searches are not successful, the codes should start searching within 'wdRefTypeNumberedItem'. To be honest, I didn't test this part because I got stuck on the second part. The code for part three is based on the second part.

I am very curious what I am not doing right and if there are any further improvements in the code, although the main goal is to get the code working at 'custom heading'. I was thinking of a 'Function' because the three parts are almost identical.

I have attached a test file in which the problem occurs with the custom heading.
Many thanks for the help in advance!!

Code:

Sub GoToHeading_test()
   
    Dim doc As Document
   Dim vHeadings As Variant
   Dim v As Variant
   Dim vLower As Variant
   Dim i As Integer
   Dim rng As Range
   Dim sArticlenumber As String

   Set doc = ActiveDocument
   
   sArticlenumber = LCase(InputBox("Enter the article number", "Enter article number"))

   ' Search for wdRefTypeHeading
   vHeadings = doc.GetCrossReferenceItems(wdRefTypeHeading)
   For Each v In vHeadings
      i = i + 1
      vLower = LCase(v)
      If InStr(Trim(vLower), Trim(sArticlenumber)) = 1 Then
         Selection.GoTo What:=wdGoToHeading, Which:=wdGoToAbsolute, Count:=i
         Selection.Bookmarks.Add Name:="MyBookmark", Range:=Selection.Range
         Selection.GoTo What:=wdGoToBookmark, Name:="MyBookmark"
         Selection.Bookmarks("MyBookmark").Delete
         Exit Sub
      End If
   Next v

   ' Search for wdRefTypeCustomHeading
   vHeadings = doc.GetCrossReferenceItems(wdRefTypeCustomHeading)
   For Each v In vHeadings
      i = i + 1
      vLower = LCase(v)
      If InStr(Trim(vLower), Trim(sArticlenumber)) = 1 Then
         Set rng = Selection.Range
         rng.Start = rng.Paragraphs(1).Range.Start
         rng.Bookmarks.Add Name:="MyBookmark", Range:=rng
         Selection.GoTo What:=wdGoToBookmark, Name:="MyBookmark"
         Selection.Bookmarks("MyBookmark").Delete
         Exit Sub
      End If
   Next v

   ' Search for wdRefTypeNumberedItem
   vHeadings = doc.GetCrossReferenceItems(wdRefTypeNumberedItem)
   For Each v In vHeadings
      i = i + 1
      vLower = LCase(v)
      If InStr(Trim(vLower), Trim(sArticlenumber)) = 1 Then
         Set rng = Selection.Range
         rng.Start = rng.Paragraphs(1).Range.Start
         rng.Bookmarks.Add Name:="MyBookmark", Range:=rng
         Selection.GoTo What:=wdGoToBookmark, Name:="MyBookmark"
         Selection.Bookmarks("MyBookmark").Delete
         Exit Sub
      End If
   Next v

   MsgBox "Couldn't find the heading containing: " & sArticlenumber
 End Sub

The original code (see url above) used the following code instead of a bookmark. I changed it to a bookmark because I wasn't sure if wdGoToHeading would work with a custom header, although afterwards it turned out that in my code a bookmark didn't work with that either...

Code:

If InStr(Trim(vlower), Trim(str)) = 1 Then
      Selection.GoTo What:=wdGoToHeading, Which:=wdGoToAbsolute, Count:=i
       Exit Sub
End If

hank1234 · #2 01-12-2023, 05:02 PM

Does anyone have an idea? :-)

BrianHoard · #3 01-12-2023, 06:30 PM

Hi Hank1234.
I've looked at this, but it's difficult to determine a way to help quickly. You have obviously thought about this quite a bit, and have a lot happening, and you explained it all well.

To help us help you, is it possible to ask a simpler question? For instance, within your situation, can you start at the first problem, and ask that by itself? Or does it all really need to be figured out all at once. The largest, toughest problems I face can usually be broken down into many smaller, simpler problems.

Those smaller, simpler ones will eventually solve your bigger problems, but for me, I only have a short amount of time to help on this forum, so I'm much more able to with smaller problems that will get you closer to your goal.

Of course, what you have done is really great how you've spelled everything out, it's just too much for me to understand quickly.

Guessed · #4 01-12-2023, 10:32 PM

The first two problems you have are:
1. wdRefTypeCustomHeading doesn't exist
2. Selection.GoTo doesn't have a type that correlates with wdRefTypeNumberedItem

Try this version of what I think you are trying to do.

Code:

Sub GoToHeading_test2()
  Dim sArticleNum As String
   
  sArticleNum = Trim(LCase(InputBox("Enter the article number", "Enter article number")))
  
  If SetRef(wdRefTypeHeading, sArticleNum) Then Exit Sub
  If SetRef(wdRefTypeNumberedItem, sArticleNum) Then Exit Sub
  'If you get this far the clause number wasn't found
  MsgBox "Couldn't find the heading containing: " & sArticleNum
End Sub

Function SetRef(iType As Integer, sParaNum As String) As Boolean
  Dim vArray As Variant, i As Integer, v As String, vLower As String
  Dim sCode As String, aXRef As Field, aRng As Range
  vArray = ActiveDocument.GetCrossReferenceItems(iType)
  For i = LBound(vArray) To UBound(vArray)
    vLower = Trim(LCase(vArray(i)))
    Debug.Print sParaNum, vLower
    If vLower Like sParaNum & "*" Then
      Set aRng = ActiveDocument.Range(Start:=0, End:=0)
      aRng.InsertCrossReference ReferenceType:=iType, ReferenceKind:=wdContentText, ReferenceItem:=i, InsertAsHyperlink:=True
      Set aXRef = ActiveDocument.Fields(1)
      Debug.Print aXRef.Code
      sCode = Split(Trim(aXRef.Code), " ")(1)
      Selection.GoTo What:=wdGoToBookmark, Name:=sCode
      aXRef.Delete
      SetRef = True
      Exit For
    End If
  Next i
End Function

hank1234 · #5 01-13-2023, 01:36 AM

Many thanks Guessed! It works perfectly

Similar Threads
Thread	Thread Starter	Forum	Replies	Last Post
Using numbered list style, how to indent text immediately following heading to match heading indent?	SpechtacularDave	Word	3	09-25-2019 01:22 PM
Capturing Numbered Headings and Sentences within Heading	lvalx	Word VBA	0	05-05-2017 06:32 AM
Restarting numbered lists in each Heading section with VBA	CN13579	Word VBA	2	11-02-2016 11:54 AM
Modify a numbered heading style	TheQueenBea	Word	3	06-05-2012 12:12 PM
MS Word 2007 numbered heading problem	gdsmithtx	Word	0	04-29-2009 02:20 PM