View Single Post
 
Old 12-26-2022, 02:33 PM
hank1234 hank1234 is offline Windows 10 Office 2016
Novice
 
Join Date: Sep 2020
Posts: 11
hank1234 is on a distinguished road
Default Jump to a numbered item with default heading and custom heading

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
Attached Files
File Type: docx Test-doc.docx (69.1 KB, 5 views)

Last edited by hank1234; 12-27-2022 at 03:14 AM. Reason: added attachment / test file
Reply With Quote