[英]Why isn't my code iterating through the tables in the word document?
There is a strange behavior in the following code that I can't understand:以下代码中有一个我无法理解的奇怪行为:
Even though we have the loop:即使我们有循环:
For each tbl in doc.Tables
...
...
Next tbl
The code is not iterating through the 6 tables in doc
, but rather is "stuck" at the second table and adds all the data to that table, ignoring all the subsequent tables.该代码没有遍历
doc
中的 6 个表,而是“卡在”第二个表中并将所有数据添加到该表中,而忽略了所有后续表。 I verified in the Interactive Window that all 6 tables are there.我在 Interactive Window 中验证了所有 6 个表都在那里。 When I step through the code using F8, the code advances to
Next tbl
and loops back to the beginning of the block, but even so tbl still points to table 2, and the data continues to get added to table 2, even though it "should" be at table 3 by this point.当我使用 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
Any ideas what I'm doing wrong?任何想法我做错了什么? I'm sure it's something very obvious, but I've been staring at the code for 4 hours and I just can't figure this out!
我确信这是非常明显的事情,但我已经盯着代码 4 个小时了,我就是想不通!
Since you're actualy using iTbl
as the index of your tables, you'd better use Item
property of Word.Tables
collection to reference a table by its index由于您实际上使用
iTbl
作为表的索引,因此您最好使用Word.Tables
集合的Item
属性通过索引引用表
hence your code would be something like:因此您的代码将类似于:
...
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
And, adopting all what already in comments and some more hints (see comments), it could become:而且,采用评论中已有的所有内容和更多提示(见评论),它可能变成:
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
I can't vouch for my knowledge of Excel VBA, I'm much more comfortable with Word VBA.我不能保证我对 Excel VBA 的了解,我对 Word VBA 更熟悉。
There are two things that can be done to greately simplify the OP code.有两件事可以大大简化 OP 代码。
From a Word perspective, use the correct Table collection从 Word 的角度来看,使用正确的 Table 集合
from a VBA perspective, separate the finding of a table from the populating of a table.从 VBA 的角度来看,将查找表与填充表分开。
I have assumed that the need to exclude the header and footer tables mentioned means that the OP is not interested in Tables that appear in the Headers or Footers.我假设需要排除提到的 header 和页脚表意味着 OP 对出现在页眉或页脚中的表不感兴趣。 This means that we can use the Word StoryRanges collection to select only those tables that appear in the main document body.
这意味着我们可以仅使用 Word StoryRanges 集合来 select 出现在主文档正文中的那些表格。
Thus因此
For Each tbl In doc.Tables
becomes变成
For Each tbl In myDoc.StoryRanges(wdMainTextStory).Tables
which, in turn, means we can eliminate the iTbl variable and the associated jiggery pokery in avoiding tables in the headers and footers.反过来,这意味着我们可以消除 iTbl 变量和相关的 jiggery pokery 以避免页眉和页脚中的表格。 (I have highlighted one area in the code where I am not certain of this elimination)
(我在代码中突出显示了一个我不确定是否会消除的区域)
I then used the refactor extract method of the fantastic and free Rubberduck addin for VBA to generate a new method that contained the code for copying a row and then revised this method to take a whole table range rather than just a row (PopulateTable).然后,我使用 VBA 的出色且免费的 Rubberduck 插件的重构提取方法生成包含复制行的代码的新方法,然后修改此方法以获取整个表范围而不仅仅是一行 (PopulateTable)。
I also used the.Add method for the Table.rows object as a simpler way of adding a row to a table.我还使用 Table.rows object 的 .Add 方法作为向表中添加行的更简单方法。
I've no idea if the code below will function as intended by the OP code but it does compile and does not have any Rubberduck inspection results so at least it is syntactically correct.我不知道下面的代码是否会像 OP 代码所预期的那样 function 但它确实可以编译并且没有任何 Rubberduck 检查结果,因此至少它在语法上是正确的。
I hope that the code below demonstrates how getting a better understanding of the Word object model, and the separation of concerns (finding a table and populating a table are two different activities) allows simpler/cleaner code.我希望下面的代码演示如何更好地理解 Word object model,以及关注点分离(查找表和填充表是两个不同的活动)允许更简单/更清洁的代码。
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
声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.