Выберите определенную страницу при условии в VBA

Question

Я пишу скрипт, который извлекает таблицы из файла Word и копирует их на лист в Excel. Однако полученные файлы Word имеют разный формат, а нужные мне таблицы не всегда находятся на одной и той же странице. Следовательно, я не могу использовать обычный индекс таблицы. Каждая таблица находится на отдельной странице, и только на этой странице где-то есть текстовая строка (может быть, а может и не быть в самой таблице), такая как «список материалов / материалов». То, что я хотел бы сделать, это сканировать каждую страницу документа Word на наличие определенной текстовой строки, и только если эта строка присутствует, используйте соответствующую таблицу на этой странице. Возможно ли это и как мне поступить?

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

Отредактировано:

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

With ActiveDocument.Content.Find
    .Text = "Equipment"
    .Forward = True
    .Execute
    If .Found = True Then Set aRange = ActiveDocument.Range(Start:=0, End:=0)
End With

Edit: Я попытался объединить код из макропода с VBA в Excel, которая копирует таблицу на лист.

Sub LookForWordDocs()
Dim FolderName As String
With Application.FileDialog(msoFileDialogFolderPicker)
  .AllowMultiSelect = False
  .Show
  On Error Resume Next
  FolderName = .SelectedItems(1)
  Err.Clear
  On Error GoTo 0
End With
    Dim sFoldPath As String: sFoldPath = FolderName     ' Change the path. Ensure that your have "\" at the end of your path
    Dim oFSO As New FileSystemObject                    ' Requires "Microsoft Scripting Runtime" reference
    Dim oFile As File
    ' Loop to go through all files in specified folder
    For Each oFile In oFSO.GetFolder(sFoldPath).Files
        ' Check if file is a word document. (Also added a check to ensure that we don't pick up a temp Word file)
        If ((InStr(1, LCase(oFSO.GetExtensionName(oFile.Path)), "doc", vbTextCompare) > 0) Or _
         (InStr(1, LCase(oFSO.GetExtensionName(oFile.Path)), "docx", vbTextCompare) > 0)) And _
                (InStr(1, oFile.Name, "~$") = 0) And _
                ((InStr(1, oFile.Name, "k") = 1) Or (InStr(1, oFile.Name, "K") = 1)) Then
            ' Call the UDF to copy from word document
            ImpTable oFile
        End If
    Next
End Sub
Sub ImpTable(ByVal oFile As File)
Dim oWdApp As New Word.Application
Dim oWdDoc As Word.Document
Dim oWdTable As Word.Table
Dim oWS As Excel.Worksheet
Dim lLastRow$, lLastColumn$
Dim s As String
s = "No correct table found"

With Excel.ThisWorkbook
Set oWS = Excel.Worksheets.Add
On Error Resume Next
oWS.Name = oFile.Name
On Error GoTo 0
Set sht = oWS.Range("A1")

Set oWdDoc = oWdApp.Documents.Open(oFile.Path)
oWdDoc.Activate
'Application.ScreenUpdating = False
Dim StrFnd As String, Rng As Word.Range, i As Long, j As Long
j = 0
StrFnd = "equipment"
 With ActiveDocument.Range
  With .Find
    .ClearFormatting
    .Replacement.ClearFormatting
    .Text = StrFnd
    .Replacement.Text = ""
    .Forward = True
    .Wrap = wdFindStop
    .Format = False
    .MatchCase = False
    .MatchWholeWord = False
    .MatchWildcards = False
    .MatchSoundsLike = False
    .MatchAllWordForms = False
    .Execute
  End With
  Do While .Find.Found
    i = .Information(wdActiveEndAdjustedPageNumber)
    Set Rng = Word.ActiveDocument.Goto(What:=wdGoToPage, Name:=i)
    Set Rng = Rng.Goto(What:=wdGoToBookmark, Name:="\page")
    If Rng.Tables.Count > 0 Then
      With Rng.Tables(1)
      Set oWdTable = Rng.Tables(1)
        oWdTable.Range.Copy
        sht.PasteSpecial xlPasteValues, xlPasteSpecialOperationNone
        j = 1
       End With
    End If
    .Start = Rng.End
    .Find.Execute
  Loop
End With
If j = 0 Then sht.Value = s
'Application.ScreenUpdating = True
oWdDoc.Close savechanges:=False
oWdApp.Quit
End With

Set oWS = Nothing
Set sht = Nothing
Set oWdDoc = Nothing
Set oWdTable = Nothing
Set Rng = Nothing

End Sub

Для первого файла код работает нормально. Однако при втором запуске я получаю ошибку во время выполнения «Удаленный серверный компьютер не существует или недоступен» в строке
"Word.ActiveDocument.Range". Я добавил пару квалификаций для элементов, но это все еще не решило проблему. Я пропускаю другую строку?

Кстати, когда я помещаю «Word» перед ActiveDocument.Range, код больше не работает.

Answer 1

Поскольку вы изменили текст с «список материалов / материалов» на «оборудование», довольно сложно понять, чего вы хотите. Попробуйте что-то вроде:

Sub Demo()
Application.ScreenUpdating = False
Dim StrFnd As String, Rng As Range, i As Long
StrFnd = InputBox("What is the Text to Find")
If Trim(StrFnd) = "" Then Exit Sub
With ActiveDocument.Range
  With .Find
    .ClearFormatting
    .Replacement.ClearFormatting
    .Text = StrFnd
    .Replacement.Text = ""
    .Forward = True
    .Wrap = wdFindStop
    .Format = False
    .MatchCase = True
    .MatchWholeWord = True
    .MatchWildcards = False
    .MatchSoundsLike = False
    .MatchAllWordForms = False
    .Execute
  End With
  Do While .Find.Found
    i = .Information(wdActiveEndAdjustedPageNumber)
    Set Rng = ActiveDocument.GoTo(What:=wdGoToPage, Name:=i)
    Set Rng = Rng.GoTo(What:=wdGoToBookmark, Name:="\page")
    If Rng.Tables.Count > 0 Then
      MsgBox Chr(34) & StrFnd & Chr(34) & " and table found on page " & i & "."
      With Rng.Tables(1)
        'process this table
      End With
    Else
      MsgBox Chr(34) & StrFnd & Chr(34) & " found on page " & i & " but no table."
    End If
    .Start = Rng.End
    .Find.Execute
  Loop
End With
Application.ScreenUpdating = True
End Sub

Примечание: приведенный выше код будет проверять все страницы, на которых найден текст поиска.