我有一个Word VBA脚本,可以为当前选择添加一些标题和表格。我现在试图让它从下表中提取信息并将其置于正确的标题下。最终目标是从表格格式中获取信息以获得更好的导航,因为Word的轮廓无法识别表格中的标题。
在获得运行时错误5941之前,我只能将表内容放入字符串变量中:集合中请求的成员不存在。调试器转到这一行:
strChildren = rngSource.Tables(1).Cell(Row:=2, Column:=4).Range.Text
该表包含两行以上和四列。为了确保集合的成员存在,我使用另一个脚本为我提供当前选择的行和列:
Sub CellRowColumn()
'For the current selection, shows a message box with the cell row and column.
With Selection.Cells(1)
MsgBox ("Column = " & .ColumnIndex & vbCr & "Row = " & .RowIndex)
End With
End Sub
我在要复制的单元格中运行了这个,它确实显示了第2行和第2行。第4栏。
这是我正在使用的代码:
Sub ElementHeadings()
'With the current selection, adds the headings for each element in the
'Elements and Attribute List (Description, Parent(s), and Child(ren)) and
'a table for attributes, with 3 columns, headed "Attribute
'Name", "Attribute Required?" and "Attribute Content")
Dim rngSelection As Range
Dim rngTable As Range
Dim rngHeading As Range
Dim rngSource As Range
Dim strCaption As String
Dim lngCaptionLength As Long
Dim strDescr As String
Dim strParents As String
Dim strChildren As String
Dim strVol As String
Dim strUsedIn As String
Set rngSelection = Selection.Range
'msgBox (rngSelection.Text)
With rngSelection
.InsertAfter ("Description")
.InsertParagraphAfter
.Expand unit:=wdParagraph
.InsertAfter ("Parent(s)")
.InsertParagraphAfter
.Expand unit:=wdParagraph
.InsertAfter ("Child(ren)")
.InsertParagraphAfter
.Expand unit:=wdParagraph
.InsertParagraphAfter
.InsertParagraphAfter
Set rngTable = .Paragraphs(5).Range
.InsertAfter ("Volume & Chapter")
.InsertParagraphAfter
.Expand unit:=wdParagraph
.InsertAfter ("Used In")
.Expand unit:=wdParagraph
.Style = "Heading 4"
'MsgBox (rngSelection.Text)
End With
ActiveDocument.Tables.Add Range:=rngTable, NumRows:=3, NumColumns:=3
With rngTable
.Tables(1).Cell(1, 1).Range.Text = "Attribute Name"
.Tables(1).Cell(1, 2).Range.Text = "Attribute Required?"
.Tables(1).Cell(1, 3).Range.Text = "Attribute Content"
.Select
GenericMacros.TableFormat
.Move unit:=wdParagraph, Count:=-1
.Select
End With
rngSelection.Select
Set rngHeading = Selection.GoTo(what:=wdGoToHeading, Which:=wdGoToPrevious)
rngHeading.Expand unit:=wdParagraph
'MsgBox (rngHeading.Text)
rngTable.Select
strCaption = rngHeading.Text
lngCaptionLength = Len(strCaption)
strCaption = Left(strCaption, lngCaptionLength - 1)
Selection.InsertCaption Label:=wdCaptionTable, Title:=". <" _
& strCaption & "> Attribute Table"
rngSelection.Select
Set rngSource = Selection.GoTo(what:=wdGoToTable, Which:=wdGoToNext)
rngSource.Expand unit:=wdTable
strDescr = rngSource.Tables(1).Cell(Row:=2, Column:=2).Range.Text
strParents = rngSource.Tables(1).Cell(Row:=2, Column:=3).Range.Text
strChildren = rngSource.Tables(1).Cell(Row:=2, Column:=4).Range.Text
strVol = rngSource.Tables(1).Cell(Row:=2, Column:=8).Range.Text
strUsedIn = rngSource.Tables(1).Cell(Row:=2, Column:=9).Range.Text
MsgBox ("strDescr = " & strDescr & vbCr & "strParents = " & strParents & _
vbCr & "strChildren =" & strChildren & vbCr & "str3001Vol = " _
& str3001Vol & "strUsedIn = " & strUsedIn)
End Sub
(这可能最终成为SuperUser问题,而不是Stack Overflow问题,如果问题是文档而不是我的代码。以前,我无法从表中复制和粘贴(复制文本但没有获得选项)把它粘贴到上面),但是不再发生了。所以如果代码没有明显的问题,可能是文档损坏或其他一些Word怪异。)
更新:我的源范围包含我刚刚创建的表,而不是我想要的表,所以我修复了创建rngSource的Selection.Goto。
答案 0 :(得分:3)
很好,您可以找到代码失败的位置。使用Selection对象往往是不可靠的,因为它可能不是你在编写代码时所假设的位置(或它在哪里)。
尽可能使用Word的对象要好得多。例如,在创建表时,对变量进行Dim,然后在创建表时将其赋值给它。这会让你在桌子上有一个“句柄”,无论之前发生什么样的编辑,都会在以后:
Dim tbl as Word.Table
Set tbl = ActiveDocument.Tables.Add(Range:=rngTable, NumRows:=3, NumColumns:=3).
tbl.Cell(1,1).Range.Text = "Attribute Name"
'and so on...
要获取现有表格,您需要能够识别它。如果你确定这个职位,那么:
Set tbl = ActiveDocument.Tables([index value])
如果这是您设置并重复使用的“模板”类型的文档,您可以将表格加入书签(选择表格并插入书签,或者单击第一个单元格并插入书签),然后:< / p>
Set tbl = ActiveDocument.Bookmarks("BookmarkName").Range.Tables(1)
以类似的方式,您可以替换它:
rngHeading.Expand unit:=wdParagraph
如果您想明确地使用该段落,请使用以下内容:
Dim para as Word.Paragraph
Set para = rngHeading.Paragraphs(1)
它也可以帮助您知道您可以将一个范围“折叠”(类似于用箭头键选择)到它的起点或终点。如果你想添加一些东西,格式化它,然后添加一些应该有不同格式的东西......这是很有用的(作为连续使用InsertAfter然后返回并以不同方式格式化东西的替代方法)。
答案 1 :(得分:0)
运行以下代码后,我得到了类似OP的内容:
Dim tbl As Word.Table: Set tbl = doc.Tables(2)
MsgBox tbl.Cell(1, 1).Range.Text
每个想法都应该在其中至少包含一个单元格, 确实注意到我也在访问错误的表;-)
因此,您可以先使用它来确定。