Почему мой код не перебирает таблицы в документе word?

Question

В следующем коде есть странное поведение, которое я не могу понять:

Даже если у нас есть l oop:

 For each tbl in doc.Tables
   ...
   ...
 Next tbl

Код не выполняет итерацию 6 таблиц в doc, а точнее «застревает» во второй таблице и добавляет все данные в эту таблицу, игнорируя все последующие таблицы. Я проверил в интерактивном окне, что все 6 таблиц есть. Когда я перебираю код, используя F8, код переходит на Next tbl и возвращается к началу блока, но даже в этом случае tbl все еще указывает на таблицу 2, и данные продолжают добавляться в таблицу 2, даже если «должен» быть в таблице 3 к этому моменту.

Public const kSchedRow = 12

Dim wd as New Word.Application
Dim doc as Word.Document
Set doc = wd.documents.open(myFile) 
Dim iTbl as integer 'Table #

iTbl = 1
For Each tbl In doc.Tables
    'skip first table in "Header" and last two tables in "footer"
    If Not (iTbl = 1 Or iTbl > doc.Tables.Count - 2) Then
        With Sheets(kVS) 'Excel sheet where the data resides to fill into Word Tables
            'Iterate through Excel table
            For Each rw In .Range(Cells(kSchedRow + 2, 1), Cells(kSchedRow + 2, 1).End(xlDown))
                'If the Excel data is intended for the current Word Table, then fill in data
                If .Cells(rw.Row, 1) = iTbl - 1 Then
                    With tbl.Rows
                        With .Last.Range
                            .Next.InsertBefore vbCr  'Insert Paragraph after end of table
                            .Next.FormattedText = .FormattedText  'Make the Paragraph a row in table
                        End With
                        With .Last
                             'Add the Excel data to the Word Table
                            .Cells(1).Range.Text = CDate(Sheets(kVS).Cells(rw.Row, 2)) & " - " & _
                                                        CDate(Sheets(kVS).Cells(rw.Row, 3)) 'Time
                            .Cells(2).Range.Text = Sheets(kVS).Cells(rw.Row, 4) 'Company
                            .Cells(3).Range.Text = Sheets(kVS).Cells(rw.Row, 5) 'Address
                            .Cells(4).Range.Text = Sheets(kVS).Cells(rw.Row, 6) 'Telephone
                            .Cells(5).Range.Text = Sheets(kVS).Cells(rw.Row, 10)
                        End With

                    End With
                End If
            Next rw
        End With
    End If
    iTbl = iTbl + 1
Next tbl

Есть идеи, что я делаю не так? Я уверен, что это что-то очень очевидное, но я смотрю на код в течение 4 часов, и я просто не могу понять это!

Answer 1

Я не могу поручиться за знание Excel VBA, мне гораздо удобнее с Word VBA.

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

1. С точки зрения Word используйте правильную коллекцию таблиц

2. с точки зрения VBA, отделите результаты поиска таблицы от заполнения таблицы.

Я предположил, что необходимость исключить упомянутые таблицы верхнего и нижнего колонтитула означает, что OP не заинтересован в таблицах, которые появляются в верхних или нижних колонтитулах. Это означает, что мы можем использовать коллекцию Word StoryRanges для выбора только тех таблиц, которые появляются в основном теле документа.

Таким образом

For Each tbl In doc.Tables

становится

For Each tbl In myDoc.StoryRanges(wdMainTextStory).Tables

, что Это, в свою очередь, означает, что мы можем исключить переменную iTbl и связанные с ней jiggery pokery, избегая таблиц в верхних и нижних колонтитулах. (Я выделил одну область в коде, где я не уверен в этом исключении)

Затем я использовал метод извлечения рефактора из fantasti c и бесплатный надстройку Rubberduck для VBA, чтобы сгенерировать новый метод, содержащий код для копирования строки, а затем пересмотрел этот метод, чтобы взять весь диапазон таблицы, а не только строку (PopulateTable).

Я также использовал метод .Add для объекта Table.rows как более простой способ добавление строки в таблицу.

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

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

Option Explicit

Public Const kSchedRow As Long = 12

Public Sub PopulateTables(ByVal ipFileName As String)

    Dim wdApp As Word.Application
    Set wdApp = New Word.Application

    Dim myDoc As Word.Document
    Set myDoc = wdApp.Documents.Open(ipFileName)

    Dim tbl As Word.Table
    ' Use the StoryRanges collection to select the correct range for the tables we want to populate
    For Each tbl In myDoc.StoryRanges.Item(wdMainTextStory).Tables
        With ThisWorkbook.Sheets("kVs") 'Excel sheet where the data resides to fill into Word Tables

            ' Define the excel range to be copied
            Dim CopyRange As Excel.Range
            Set CopyRange = .Range(.Cells(kSchedRow + 2, 1), .Cells(kSchedRow + 2, 1).End(xlDown))

            ' We are now copying tables from the main content of the document
            ' so I think this test is now redundant

            'If .Cells(rw.Row, 1) = iTbl - 1 Then '
            PopulateTable tbl, CopyRange
            ' End if
        End With
    Next tbl

End Sub

Public Sub PopulateTable(ByVal ipTable As Word.Table, ByVal ipCopyRange As Excel.Range)

    Dim rw As Excel.Range
    For Each rw In ipCopyRange
        With ipTable.Rows

            ' add a row at the bottom of the table
            .Add

            'Add the Excel data to the Word Table
            With .Last
                .Cells.Item(1).Range.Text = CDate(rw.Cells.Item(rw.Row, 2)) & " - " & _
                                            CDate(rw.Cells.Item(rw.Row, 3)) 'Time
                .Cells.Item(2).Range.Text = rw.Cells.Item(rw.Row, 4) 'Company
                .Cells.Item(3).Range.Text = rw.Cells.Item(rw.Row, 5) 'Address
                .Cells.Item(4).Range.Text = rw.Cells.Item(rw.Row, 6) 'Telephone
                .Cells.Item(5).Range.Text = rw.Cells.Item(rw.Row, 10)
            End With

        End With

    Next

End Sub

Answer 2

Поскольку вы действительно используете iTbl в качестве индекса ваших таблиц, вам лучше использовать свойство Item коллекции Word.Tables, чтобы ссылаться на таблицу по ее индексу

, следовательно, ваш код будет быть чем-то вроде:

...
Dim wd As New Word.Application
Dim doc As Word.Document

...

Dim tbl As Word.Table '<-- full qualified explicit declaration
Dim iTbl As Long 'Table #

With doc.Tables ' reference word doc tables collection
    For iTbl = 2 To .Count - 2 'skip first table ("Header") and last two tables ("footer")
        For Each rw ...
                With .Item(iTbl).Rows '<-- use Item property of Word.Table object to address a table by its index
                    With .Last.Range
                        ...
                    End With
                    With .Last
                        ...
                    End With

                End With
            End If
        Next rw
    Next
End With

И, принимая все, что уже есть в комментариях и еще несколько подсказок (см. комментарии), оно может стать:

Option Explicit

Public Const kSchedRow As Long = 12 ' <-- full qualified explicit declaration

Sub MySub()

    Dim myFile As String, kVS As String '<-- explicit declaration

    myFile = ...
    kVS = ...

    Dim wd As New Word.Application
    Dim doc As Word.Document
    Set doc = wd.Documents.Open(myFile)

    Dim tbl As Word.Table '<-- full qualified explicit declaration
    Dim iTbl As Long 'Table #

    Dim rw As Range '<-- declaration of a (Excel) Range variable to loop throug an excel Range object
    Dim kVsRng As Range '<--  declaration of a (Excel) Range variable
    With Sheets(kVS) ' <-- Excel sheet where the data resides to fill into Word Tables
        Set kVsRng = .Range(.Cells(kSchedRow + 2, 1), .Cells(kSchedRow + 2, 1).End(xlDown)) '<-- set your excel range once and use it throughout the rest fo the code
    End With

    With doc.Tables ' reference word doc tables collection
        For iTbl = 2 To .Count - 2 'skip first table in "Header" and last two tables in "footer"
            'Iterate through Excel table wanted range
            For Each rw In kVsRng
                'If the Excel data is intended for the current Word Table, then fill in data
                If rw.Value = iTbl - 1 Then '< -- rw is already a cell in column 1, so use it directly
                    With .Item(iTbl).Rows '<-- use Item property of Word.Table object to address a table by its index
                        With .Last.Range
                            .Next.InsertBefore vbCr  'Insert Paragraph after end of table
                            .Next.FormattedText = .FormattedText  'Make the Paragraph a row in table
                        End With
                        With .Last
                             'Add the Excel data to the Word Table
                             ' <-- use column offsets from current rw cell to reach other cells in different columns of the same row
                            .Cells(1).Range.Text = CDate(rw.Offset(, 1).Value) & " - " & _
                                                        CDate(rw.Offset(, 2).Value) 'Time
                            .Cells(2).Range.Text = rw.Offset(, 3).Value 'Company
                            .Cells(3).Range.Text = rw.Offset(, 4).Value 'Address
                            .Cells(4).Range.Text = rw.Offset(, 5).Value 'Telephone
                            .Cells(5).Range.Text = rw.Offset(, 9).Value
                        End With

                    End With
                End If
            Next rw
        Next
    End With


    ...


End Sub