excel - 为什么我的代码没有遍历 word 文档中的表格？

Question

以下代码中有一个我无法理解的奇怪行为:

即使我们有循环:

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

代码未遍历 doc 中的 6 个表，而是“卡在”第二个表并将所有数据添加到该表中，而忽略所有后续表。我在交互式窗口中验证了所有 6 个表都在那里。当我使用 F8 单步执行代码时，代码前进到 Next tbl并循环回到 block 的开头，但即便如此 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 代码。

从 Word 的角度来看，使用正确的表格集合

从 VBA 的角度来看，将查找表与填充表分开。

我假设需要排除提到的页眉和页脚表意味着 OP 对出现在页眉或页脚中的表不感兴趣。这意味着我们可以使用 Word StoryRanges 集合仅选择出现在主文档正文中的那些表格。

因此

For Each tbl In doc.Tables

变成

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

反过来，这意味着我们可以消除 iTbl 变量和相关的 jiggery pokery 以避免页眉和页脚中的表格。 (我在代码中突出显示了一个我不确定是否会消除的区域)

然后，我使用了用于 VBA 的出色且免费的 Rubberduck 插件的重构提取方法来生成一个新方法，其中包含用于复制行的代码，然后修改此方法以获取整个表范围而不仅仅是一行 (PopulateTable)。

我还使用 Table.rows 对象的 .Add 方法作为向表中添加行的更简单方法。

我不知道下面的代码是否会按照 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