Retrieve page number of cross reference

[NobodysPerfect]

Hi to all

I’d like to fill a 2column list box (user form) with all headings (1. column) of a document with corresponding page number (2. column).
There is no problem to get the headings = ActiveDocument.GetCrossReferenceItems, no problem to fill listbox(es), but I simply do not know how to retrieve and save the page number.

Any ideas, help would be appreciated


NP

[gmaxey]

Sub ScratchMacro()
'A basic Word macro coded by Greg Maxey
Dim arrHeadings() As String
Dim lngIndex As Long, lngHeading As Long
  For lngIndex = 1 To ActiveDocument.Paragraphs.Count
    If Left(ActiveDocument.Paragraphs(lngIndex).Range.Style, Len("Heading")) = "Heading" Then
      ReDim Preserve arrHeadings(1, lngHeading)
      arrHeadings(0, lngHeading) = ActiveDocument.Paragraphs(lngIndex).Range.Text
      arrHeadings(1, lngHeading) = ActiveDocument.Paragraphs(lngIndex).Range.Information(wdActiveEndPageNumber)
      lngHeading = lngHeading + 1
    End If
  Next
  With UserForm1
    .listHeadings.Column = arrHeadings
    .listHeadings.ColumnCount = 2
    .listHeadings.ColumnWidths = "100;20"
    .Show
  End With
End Sub

[NobodysPerfect]

Hi,

Thanks for your answer.

Meanwhile I also tried:

Sub GetCrossReferences()
Dim oDoc As Document: Set oDoc = ActiveDocument
Dim myRefs As Variant, i As Long
   
    myRefs = oDoc.GetCrossReferenceItems(wdRefTypeHeading)
    For I = 1 To UBound(myRefs)
        With Selection.Find
            .Text = Trim$(myRefs(i))
            .Forward = True
        End With
        Selection.Find.Execute
        MsgBox myRefs(i) & " auf Seite:" & Selection.Information(wdActiveEndPageNumber), vbOKOnly
    Next
   
End Sub

Cheers
NP

[gmaxey]

NP,

I'm sure that worked in your case or you wouldn't have posted it. There is, while perhaps remote, the chance of inaccuracies with that method. If heading text is repeated in a non-heading paragraph or if heading are repeated then it would return false or inaccurate results.

[NobodysPerfect]

You are right , so I included the .Find.Style option to the search.

Which code, do you think, will be faster for long documents.

Cheers
NP

[gmaxey]

I think this would be faster and more comprehensive:

Sub GetHeadings()
Dim oDoc As Document: Set oDoc = ActiveDocument
Dim varHeadings As Variant, lngIndex As Long
Dim oRng As Word.Range
  varHeadings = oDoc.GetCrossReferenceItems(wdRefTypeHeading)
  Set oRng = oDoc.Range
  For lngIndex = 1 To UBound(varHeadings)
    With oRng.Find
      .Text = Trim$(varHeadings(lngIndex))
      .Forward = True
      If .Execute Then
        If Left(oRng.Paragraphs(1).Range.Style, Len("Heading")) = "Heading" Then
          MsgBox varHeadings(lngIndex) & " auf Seite:" & oRng.Information(wdActiveEndAdjustedPageNumber), vbOKOnly
        End If
        oRng.Collapse wdCollapseEnd
      End If
    End With
  Next
lbl_Exit:
  Exit Sub
End Sub

[NobodysPerfect]

With your comprehensive solution this thread seems to be REALLY solved .

Thanks
NP