vba: вернуть номер страницы из selection.find, используя текст из массива

(Примечание. См. Решение ниже.)

Я пытался извлечь номера страниц из страниц, на которых находятся различные заголовки в текстовом документе, используя VBA. Мой текущий код возвращает 2 или 3, а не правильно связанные номера страниц, в зависимости от того, где и как я использую его в своей основной подпрограмме.

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 это тестовый документ, который я создал с 10 заголовками на 3 страницах. У меня есть заголовки, извлеченные изgetCrossReferenceItems Метод используется позже в моем коде.

Я пытаюсь просмотреть результаты изgetCrossReferenceItems метод и использовать каждый из них в объекте Find наdocSource и из этого выясните, на какой странице находится результат. Номера страниц будут позже использованы в строке в моем коде. Эта строка плюс номер страницы будет добавлена в другой документ, который создается в начале моей основной подпрограммы, все остальное работает, но этот сегмент кода.

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

Проблемы решены

Спасибо, Кевин, вы мне очень помогли, теперь у меня есть именно то, что мне нужно, по результатам этого.Sub

docSource - это тестовый документ, который я создал с 10 заголовками на 3 страницах. docOutline - это новый документ, который будет действовать как оглавление.

Я должен был использовать этоSub над словомs встроенные функции оглавления, потому что:

У меня есть несколько документов для включения, я мог бы использоватьRD поле, чтобы включить их, но

у меня есть другойSub который генерирует настраиваемую десятичную нумерацию страниц в каждом документе 0.0.0 (представитель chapter.section.page), который, чтобы весь пакет документов имел смысл, должен быть включен в оглавление в качестве номеров страниц. Вероятно, есть другой способ сделать это, но я придумал слово "Встроенные функции.

Это станет функцией, которая будет включена в нумерацию моей страницыSub, В настоящее время я нахожусь на 3/4 пути к завершению этого небольшого проекта, последний квартал должен быть простым.

Пересмотрен и убран окончательный кодекс

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 
 Kevin Pope12 нояб. 2012 г., 21:20
Спасибо за это, Фил. Я'обновил мой ответ новым фрагментом кода, чтобы попробовать. Это'последний раздел кода в моем ответе. Нет проблем с процедурами публикации - всегда требуется некоторое время, чтобы сделать это правильно. :-)
 brettdj13 нояб. 2012 г., 12:52
Несмотря на то, что вы опубликовали свой окончательный код, похвально, оригинальный вопрос больше не виден после публикации.

Ответы на вопрос(1)

Решение Вопроса

Это выглядит какSelection.Information(wdActiveEndPageNumber) будет отвечать всем требованиям, хотя этоs в неправильной точке вашего кода в настоящее время. Поместите эту строку после выполнения поиска, вот так:

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

Дополнение к новому вопросу:

Когда ты'переустанавливая значения strFooter, выповторное использованиеReDim изменить размер массива, когда вы должны использовать:ReDim Preserve

ReDim Preserve strFootNum(1 To UBound(astrHeadings))

Но, еслиUBound(astrHeadings) меняется во времяFor кругом вопрос, это 'Вероятно, будет наилучшей практикой, чтобы вытянутьReDim утверждение вне цикла:

ReDim strFootNum(0 To UBound(astrHeadings))
For i = 0 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
        strFootNum(i) = 0 'Or whatever you want to do if it's not found'
    End If
    Selection.Move  
Next

Для справки,ReDim оператор устанавливает все элементы в массиве обратно в 0, тогда какReDim Preserve сохраняет все данные в массиве до изменения его размера.

Также обратите внимание наSelection.Move и.Wrap = wdFindContinue линии - я думаю, что это было корнем проблемы с моими предыдущими предложениями. Выбор будет установлен на последнюю страницу, потому что поиск не былОбтекание любого прогона, кроме первого.

 Phil Clayton12 нояб. 2012 г., 23:06
Привет Кевин, я нене может быть более 15 представителей, так что можетепока не голосую :-(
 Kevin Pope12 нояб. 2012 г., 23:07
Тот'все в порядке - все в свое время! :-) Рад, что смог помочь!

Ваш ответ на вопрос