《循环在WORD+VBA中的应用.doc》由会员分享，可在线阅读，更多相关《循环在WORD+VBA中的应用.doc（70页珍藏版）》请在金锄头文库上搜索。
1、循环在WORD VBA中的应用循环在WORD VBA中的应用001在活动文档的开头插入一张 4 列 3 行的表格。For Each.Next 结构用于循环遍历表格中的每个单元格。在 For Each.Next 结构中，InsertAfter 方法用于将文字添至表格单元格（单元格 1、单元格 2、以此类推）。Sub CreateNewTable() Dim docActive As Document Dim tblNew As Table Dim celTable As Cell Dim intCount As Integer Set docActive = ActiveDocument Set
2、 tblNew = docActive.Tables.Add( _ Range:=docActive.Range(Start:=0, End:=0), NumRows:=3, _ NumColumns:=4) intCount = 1 For Each celTable In tblNew.Range.Cells celTable.Range.InsertAfter Cell & intCount intCount = intCount + 1 Next celTable tblNew.AutoFormat Format:=wdTableFormatColorful2, _ ApplyBord
3、ers:=True, ApplyFont:=True, ApplyColor:=TrueEnd Sub002在活动文档中第一张表格的第一个单元格中插入文字。Cell 方法返回单独的 Cell 对象。Range 属性返回一个 Range 对象。Delete 方法用于删除现有的文字，而 InsertAfter 方法用于插入文字“Cell 1,1”。Sub InsertTextInCell() If ActiveDocument.Tables.Count = 1 Then With ActiveDocument.Tables(1).Cell(Row:=1, Column:=1).Range .Del
4、ete .InsertAfter Text:=Cell 1,1 End With End IfEnd Sub003返回并显示文档中第一张表格的第一行中每个单元格的内容。Sub ReturnTableText() Dim tblOne As Table Dim celTable As Cell Dim rngTable As Range Set tblOne = ActiveDocument.Tables(1) For Each celTable In tblOne.Rows(1).Cells Set rngTable = ActiveDocument.Range(Start:=celTable
5、.Range.Start, _ End:=celTable.Range.End - 1) MsgBox rngTable.Text Next celTableEnd SubSub ReturnCellText() Dim tblOne As Table Dim celTable As Cell Dim rngTable As Range Set tblOne = ActiveDocument.Tables(1) For Each celTable In tblOne.Rows(1).Cells Set rngTable = celTable.Range rngTable.MoveEnd Uni
6、t:=wdCharacter, Count:=-1 MsgBox rngTable.Text Next celTableEnd Sub004在活动文档的开头插入用制表符分隔的文本，然后将这些文本转换为表格。Sub ConvertExistingText() With Documents.Add.Content .InsertBefore one & vbTab & two & vbTab & three & vbCr .ConvertToTable Separator:=Chr(9), NumRows:=1, NumColumns:=3 End WithEnd Sub005定义一个数组，该数组
7、的元素个数等于文档中第一张表格（假定为 Option Base 1）中的单元格数。For Each.Next 结构用于返回每个表格单元格的内容，并将文字指定给相应的数组元素。Sub ReturnCellContentsToArray() Dim intCells As Integer Dim celTable As Cell Dim strCells() As String Dim intCount As Integer Dim rngText As Range If ActiveDocument.Tables.Count = 1 Then With ActiveDocument.Tables
8、(1).Range intCells = .Cells.Count ReDim strCells(intCells) intCount = 1 For Each celTable In .Cells Set rngText = celTable.Range rngText.MoveEnd Unit:=wdCharacter, Count:=-1 strCells(intCount) = rngText intCount = intCount + 1 Next celTable End With End IfEnd Sub006将当前文档中的表格复制到新文档中。Sub CopyTablesToN
9、ewDoc() Dim docOld As Document Dim rngDoc As Range Dim tblDoc As Table If ActiveDocument.Tables.Count = 1 Then Set docOld = ActiveDocument Set rngDoc = Documents.Add.Range(Start:=0, End:=0) For Each tblDoc In docOld.Tables tblDoc.Range.Copy With rngDoc .Paste .Collapse Direction:=wdCollapseEnd .Inse
10、rtParagraphAfter .Collapse Direction:=wdCollapseEnd End With Next End IfEnd Sub007显示 Documents 集合中每个文档的名称。Sub LoopThroughOpenDocuments() Dim docOpen As Document For Each docOpen In Documents MsgBox docOpen.Name Next docOpenEnd Sub008使用数组存储活动文档中包含的所有书签的名称。Sub LoopThroughBookmarks() Dim bkMark As Book
11、mark Dim strMarks() As String Dim intCount As Integer If ActiveDocument.Bookmarks.Count 0 Then ReDim strMarks(ActiveDocument.Bookmarks.Count - 1) intCount = 0 For Each bkMark In ActiveDocument.Bookmarks strMarks(intCount) = bkMark.Name intCount = intCount + 1 Next bkMark End IfEnd Sub009更新活动文档中的 DAT
12、E 域。Sub UpdateDateFields() Dim fldDate As Field For Each fldDate In ActiveDocument.Fields If InStr(1, fldDate.Code, Date, 1) Then fldDate.Update Next fldDateEnd Sub010如果名为“Filename”的词条是 AutoTextEntries 集合中的一部分，则以下示例显示一条消息。Sub FindAutoTextEntry() Dim atxtEntry As AutoTextEntry For Each atxtEntry In A
13、ctiveDocument.AttachedTemplate.AutoTextEntries If atxtEntry.Name = Filename Then _ MsgBox The Filename AutoText entry exists. Next atxtEntryEnd Sub011在第一个表格中添加一行，然后将文本 Cell 插入该行。Sub CountCells() Dim tblNew As Table Dim rowNew As Row Dim celTable As Cell Dim intCount As Integer intCount = 1 Set tblNew = ActiveDocument.Tables(1) Set rowNew = tblNew.Rows.Add(BeforeRow:=tblNew.Rows(1) For Each celTable In rowNew.Cells
