Как определить номер страницы в word vba

Задача оказалась не так тривиальна как кажется Прошу помощи
В вопросе определения текущего номера страницы все зависит от цели:

1. Если нужно определить номер станицы чисто для «себя», то есть для использования внутри своей программы, чтобы просто ориентироваться по тексту, то это да

1
2
3
4

Sub Макрос1()
 MsgBox Selection.Information(wdActiveEndPageNumber)  'это номер с начала документа
 MsgBox Selection.Information(wdActiveEndAdjustedPageNumber) 'это номер по установленной нумерации страниц
End Sub

2. Если нужно же определить номер страницы текущего текста в окончательном документе, например в распечатанном документе (или например в сохраненным в pdf), то это уже совершенно другая задача.
Хитрость здесь в том, что предыдущий макрос возвращает номер страницы в текущем режиме просмотра документа (обычно это «разметка») и это номер может не совпасть с реальным номером страницы уже распечатанного документа, потому что включены просмотры кодов полей или в документе установлен предметный указатель и по всему документу идет разметка этих слов, которые занимают место на экране и сдвигают текст вниз.
Таким образом следующий макрос для некоторых строк вернет другие значения:

1
2
3
4
5
6

Sub Макрос2()
 Application.PrintPreview = True
 MsgBox Selection.Information(wdActiveEndPageNumber)
 MsgBox Selection.Information(wdActiveEndAdjustedPageNumber)
 Application.PrintPreview = False
End Sub

Вопрос: Как получить реальный номер страницы?
То есть у меня стоит задача найти по тексту абзацы с некоторыми словами и сохранить в отдельном файле со ссылками на страницы. В документе есть предметный указатель со множеством слов и коды отображаются по всему тексту типа «опасные грузы { XE «опасные грузы»} -это вещества…» из-за которых и происходит смещение страниц.
Есть ли другое решение? нежели переключать режим на предпросмотр — это же будет моргать окна при выполнении.

во вложении пример документа — попробуйте определить номер станицы последней строки этими двумя макросами
Документ предоставлен КонсультантПлюс2.docx

Алексей задал вопрос:

Как программно определить номер текущей страницы? Единственное, до чего я додумался — по проценту скробара. Но правильно ли это?

В VBA есть две константы, по которым можно определить номер текущей страницы:

• wdActiveEndPageNumber
• wdActiveEndAdjustedPageNumber

Первая константа wdActiveEndPageNumber используется тогда, когда в документе нумерация начинается с первого номера (нормальная нумерация), а вторая — wdActiveEndAdjustedPageNumber — если пользователь использует свою нумерацию документа (не с первого по порядку листа документа).

Как я полагаю, в случае Алексея нужно узнать номер текущей страницы, на которой находится курсор ввода и нумерация страниц правильная. Вот примерный код:

Sub currentPage()
Dim pn As String
pn = Selection.Information(wdActiveEndPageNumber)
MsgBox pn
End Sub

(Note: See below for solution.)

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.

astrHeadings = docSource.GetCrossReferenceItems(wdRefTypeHeading)

For Each hds In astrHeadings
        docSource.Activate
        With Selection.Find
            .Text = Trim$(hds)
            .Forward = True
            MsgBox hds & ":" & Selection.Information(wdActiveEndPageNumber), vbOKOnly
        End With
        Selection.Find.Execute
Next

docSource is a test document I have set up with 10 headings over 3 pages. I have the headings retrieved from the getCrossReferenceItems method in use later in my code.

What I am attempting is to loop through the results from the getCrossReferenceItems method and use each them in a Find object on docSource 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.

Ideally what I need this segment to do is fill a second array with the associated page numbers from each Find result.

Problems Solved

Thanks Kevin you have been a great help here, I now have exactly what I need from the output of this Sub.

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.

I have had to use this Sub over Word’s built-in TOC features because:

1. I have multiple documents to include, I could use the RD field to include these but

2. I have another Sub 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.

This will become a Function to be included in my page numbering Sub. I am currently 3/4 of the way to completing this little project, the last quarter should be straightforward.

Revised and cleaned final 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 <= minLevel Then
                If intLevel = "1" Then
                    strText = " " & Trim$(astrHeadings(intItem)) & vbTab & "1" & "." & "2" & "." & strFootNum(intItem) & vbCr
                End If
                If intLevel = "2" Then
                    strText = "   " & Trim$(astrHeadings(intItem)) & vbTab & "1" & "." & "2" & "." & strFootNum(intItem) & vbCr
                End If
                If intLevel = "3" Then
                    strText = "      " & Trim$(astrHeadings(intItem)) & vbTab & "1" & "." & "2" & "." & strFootNum(intItem) & vbCr
                End If
                If intLevel = "4" Then
                    strText = "         " & Trim$(astrHeadings(intItem)) & vbTab & "1" & "." & "2" & "." & strFootNum(intItem) & vbCr
                End If
                If intLevel = "5" Then
                    strText = "            " & Trim$(astrHeadings(intItem)) & vbTab & "1" & "." & "2" & "." & strFootNum(intItem) & vbCr
                End If
            ' Add the text to the document.
            rng.InsertAfter strText & 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

This code is now producing (What it should be according to my headings specification found in test-doc.docx):

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

In Addition to this I have solved the ActiveDocument switching issue by using docSource.select and docOutline.Select statements instead of using.Active.

Thanks again Kevin, greatly appreciated

Phil

Вернуться в VBA

Кто сейчас на конференции

Сейчас этот форум просматривают: нет зарегистрированных пользователей и гости: 2