Note that there are some explanatory texts on larger screens.

plurals
  1. POvba: return page number from selection.find using text from array
    primarykey
    data
    text
    <p>(Note: See below for solution.)</p> <p>I have been trying to retrieve the page numbers from pages that various headings reside on in a word document using VBA. My current code returns either 2 or 3, and not the correctly associated page numbers, depending on where and how I use it in my main Sub.</p> <pre><code>astrHeadings = docSource.GetCrossReferenceItems(wdRefTypeHeading) For Each hds In astrHeadings docSource.Activate With Selection.Find .Text = Trim$(hds) .Forward = True MsgBox hds &amp; ":" &amp; Selection.Information(wdActiveEndPageNumber), vbOKOnly End With Selection.Find.Execute Next </code></pre> <p><code>docSource</code> is a test document I have set up with 10 headings over 3 pages. I have the headings retrieved from the <code>getCrossReferenceItems</code> method in use later in my code.</p> <p>What I am attempting is to loop through the results from the <code>getCrossReferenceItems</code> method and use each them in a Find object on <code>docSource</code> and from this ascertain what page the result is on. The page numbers will then be used in a string later in my code. This string plus page number will be added to another document which is created at the beginning of my main sub, everything else works a treat but this code segment.</p> <p>Ideally what I need this segment to do is fill a second array with the associated page numbers from each Find result.</p> <p><strong>Problems Solved</strong></p> <p>Thanks Kevin you have been a great help here, I now have exactly what I need from the output of this <code>Sub</code>. </p> <p>docSource is a test document I have set up with 10 headings over 3 pages. docOutline is a new document which will act as a Table of Contents document. </p> <p>I have had to use this <code>Sub</code> over Word's built-in TOC features because: </p> <ol> <li><p>I have multiple documents to include, I could use the <code>RD</code> field to include these but </p></li> <li><p>I have another <code>Sub</code> which generates custom decimal page numbering in each document 0.0.0 (chapter.section.page representative) that, for the whole document package to make sense, need to be included in the TOC as page numbers. There probably is another way of doing this but I came up blank with Word's built-in features.</p></li> </ol> <p>This will become a Function to be included in my page numbering <code>Sub</code>. I am currently 3/4 of the way to completing this little project, the last quarter should be straightforward. </p> <p><strong>Revised and cleaned final Code</strong></p> <pre><code>Public Sub CreateOutline() ' from http://stackoverflow.com/questions/274814/getting-the-headings-from-a-word-document Dim docOutline As Word.Document Dim docSource As Word.Document Dim rng As Word.Range Dim strFootNum() As Integer Dim astrHeadings As Variant Dim strText As String Dim intLevel As Integer Dim intItem As Integer Dim minLevel As Integer Dim tabStops As Variant Set docSource = ActiveDocument Set docOutline = Documents.Add minLevel = 5 'levels above this value won't be copied. ' Content returns only the ' main body of the document, not ' the headers and footer. Set rng = docOutline.Content astrHeadings = docSource.GetCrossReferenceItems(wdRefTypeHeading) docSource.Select ReDim strFootNum(0 To UBound(astrHeadings)) For i = 1 To UBound(astrHeadings) With Selection.Find .Text = Trim(astrHeadings(i)) .Wrap = wdFindContinue End With If Selection.Find.Execute = True Then strFootNum(i) = Selection.Information(wdActiveEndPageNumber) Else MsgBox "No selection found", vbOKOnly End If Selection.Move Next docOutline.Select With Selection.Paragraphs.tabStops '.Add Position:=InchesToPoints(2), Alignment:=wdAlignTabLeft .Add Position:=InchesToPoints(6), Alignment:=wdAlignTabRight, Leader:=wdTabLeaderDots End With For intItem = LBound(astrHeadings) To UBound(astrHeadings) ' Get the text and the level. ' strText = Trim$(astrHeadings(intItem)) intLevel = GetLevel(CStr(astrHeadings(intItem))) ' Test which heading is selected and indent accordingly If intLevel &lt;= minLevel Then If intLevel = "1" Then strText = " " &amp; Trim$(astrHeadings(intItem)) &amp; vbTab &amp; "1" &amp; "." &amp; "2" &amp; "." &amp; strFootNum(intItem) &amp; vbCr End If If intLevel = "2" Then strText = " " &amp; Trim$(astrHeadings(intItem)) &amp; vbTab &amp; "1" &amp; "." &amp; "2" &amp; "." &amp; strFootNum(intItem) &amp; vbCr End If If intLevel = "3" Then strText = " " &amp; Trim$(astrHeadings(intItem)) &amp; vbTab &amp; "1" &amp; "." &amp; "2" &amp; "." &amp; strFootNum(intItem) &amp; vbCr End If If intLevel = "4" Then strText = " " &amp; Trim$(astrHeadings(intItem)) &amp; vbTab &amp; "1" &amp; "." &amp; "2" &amp; "." &amp; strFootNum(intItem) &amp; vbCr End If If intLevel = "5" Then strText = " " &amp; Trim$(astrHeadings(intItem)) &amp; vbTab &amp; "1" &amp; "." &amp; "2" &amp; "." &amp; strFootNum(intItem) &amp; vbCr End If ' Add the text to the document. rng.InsertAfter strText &amp; vbLf docOutline.SelectAllEditableRanges ' tab stop to set at 15.24 cm 'With Selection.Paragraphs.tabStops ' .Add Position:=InchesToPoints(6), _ ' Leader:=wdTabLeaderDots, Alignment:=wdAlignTabRight ' .Add Position:=InchesToPoints(2), Alignment:=wdAlignTabCenter 'End With rng.Collapse wdCollapseEnd End If Next intItem End Sub Private Function GetLevel(strItem As String) As Integer ' from http://stackoverflow.com/questions/274814/getting-the-headings-from-a-word-document ' Return the heading level of a header from the ' array returned by Word. ' The number of leading spaces indicates the ' outline level (2 spaces per level: H1 has ' 0 spaces, H2 has 2 spaces, H3 has 4 spaces. Dim strTemp As String Dim strOriginal As String Dim intDiff As Integer ' Get rid of all trailing spaces. strOriginal = RTrim$(strItem) ' Trim leading spaces, and then compare with ' the original. strTemp = LTrim$(strOriginal) ' Subtract to find the number of ' leading spaces in the original string. intDiff = Len(strOriginal) - Len(strTemp) GetLevel = (intDiff / 2) + 1 End Function </code></pre> <p>This code is now producing (What it should be according to my headings specification found in test-doc.docx):</p> <pre><code>This is heading one 1.2.1 This is heading two 1.2.1 This is heading two.one 1.2.1 This is heading two.three 1.2.1 This is heading one.two 1.2.2 This is heading three 1.2.2 This is heading four 1.2.2 This is heading five 1.2.2 This is heading five.one 1.2.3 This is heading five.two 1.2.3 </code></pre> <p>In Addition to this I have solved the <code>ActiveDocument</code> switching issue by using <code>docSource.select</code> and <code>docOutline.Select</code> statements instead of using<code>.Active</code>.</p> <p>Thanks again Kevin, greatly appreciated :-)</p> <p>Phil</p>
    singulars
    1. This table or related slice is empty.
    plurals
    1. This table or related slice is empty.
 

Querying!

 
Guidance

SQuiL has stopped working due to an internal error.

If you are curious you may find further information in the browser console, which is accessible through the devtools (F12).

Reload