Поиск КАЖДОГО заголовка в документе Word с использованием Excel VBA?

Question

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

Моя проблема в том, что в настоящее время он ищет только первую страницу при открытии документа, но для каждого документа, требующего поиска, существует около 400 страниц.да 'или' нет 'для определения местонахождения данных, чтобы сэкономить при печати. ​​

Я был бы чрезвычайно признателен за любую помощь, которую вы можете предоставить, или указатели.

Answer 1

Неэффективность вашего кода в значительной степени связана с ненужным повторным созданием и уничтожением сеансов Word.Вы также используете именованные константы Word, что несовместимо с поздним связыванием, подразумеваемым CreateObject («Word.Application»).Еще одна вещь, о которой вам нужно знать (как указала Синди), состоит в том, что разделы, а не страницы, имеют заголовки.Кроме того, заголовки могут быть связаны с заголовками в предыдущих разделах, и в этом случае они не нуждаются в индивидуальном тестировании.Поскольку вы пытаетесь найти контент, который может находиться в первичном заголовке любого раздела, лучше использовать коллекцию StoryRanges.Попробуйте:

Private Sub CommandButton1_Click()
Dim ObjWrd As Object, ObjDoc As Object, ObjSctn As Object, ObjHdFt As Object
Dim xlWkSht As Worksheet, r As Long
Set xlWkSht = activesheet: i = 2
Set ObjWrd = CreateObject("Word.Application")
With ObjWrd
  .Visible = True
  Do While xlWkSht.Cells(r, 1).Value <> ""
    Set ObjDoc = wdApp.Documents.Open("\\Location" & Cells(i, 9) & ".docx", False, True, False)
    With ObjDoc
      With .StoryRanges(7).Find '7 = wdPrimaryHeaderStory
        .ClearFormatting
        .Text = Cells(i, 11).Value
        .Forward = True
        .Wrap = 0 '0 = wdFindStop
        .Format = False
        .MatchCase = False
        .MatchWholeWord = True
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
        .Execute
        If .Found = True Then
          xlWkSht.Cells(r, 12).Value = "Yes"
        Else
          xlWkShtCells(r, 12).Value = "No"
        End If
      End With
      .Close False
    End With
    r = r + 1
  Loop
  .Quit
End With
End Sub

Еще одна вещь, о которой следует помнить, это то, что документы Word имеют три верхних и нижних колонтитула в разделе (четные страницы, первая страница и основной).Приведенный выше код ищет только основной заголовок.Если вы хотите искать и других, вам нужен код, например:

Private Sub CommandButton1_Click()
Dim ObjWrd As Object, ObjDoc As Object, ObjSctn As Object, ObjHdFt As Object
Dim xlWkSht As Worksheet, r As Long, i As Long
Set xlWkSht = activesheet: i = 2
Set ObjWrd = CreateObject("Word.Application")
With ObjWrd
  .Visible = True
  Do While xlWkSht.Cells(r, 1).Value <> ""
    xlWkShtCells(r, 12).Value = "No"
    Set ObjDoc = wdApp.Documents.Open("\\Location" & Cells(i, 9) & ".docx", False, True, False)
    With ObjDoc
      For i = 6 To 10
        Select Case i
          Case 6, 7, 10 '6 = wdEvenPagesHeaderStory, 7 = wdPrimaryHeaderStory, 10 = wdFirstPageHeaderStory
            With .StoryRanges(i).Find
              .ClearFormatting
              .Text = Cells(i, 11).Value
              .Forward = True
              .Wrap = 0 '0 = wdFindStop
              .Format = False
              .MatchCase = False
              .MatchWholeWord = True
              .MatchWildcards = False
              .MatchSoundsLike = False
              .MatchAllWordForms = False
              .Execute
              If .Found = True Then
                xlWkSht.Cells(r, 12).Value = "Yes"
                Exit For
              End If
            End With
          Case Else 'Do nothing
        End Select
      .Close False
    End With
    r = r + 1
  Loop
  .Quit
End With
End Sub