循环在WORDVBA中的应用剖析Word文档格式.docx

1、002在活动文档中第一张表格的第一个单元格中插入文字。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 .Delete .InsertAfter Text:=Cell 1,1 End With End If003返

2、回并显示文档中第一张表格的第一行中每个单元格的内容。Sub ReturnTableText（） Dim tblOne As Table Dim rngTable As Range Set tblOne = ActiveDocument.Tables（1） For Each celTable In tblOne.Rows（1）.Cells Set rngTable = ActiveDocument.Range（Start:=celTable.Range.Start, _ End:=celTable.Range.End - 1） MsgBox rngTable.TextSub ReturnCell

3、Text（） Set rngTable = celTable.Range rngTable.MoveEnd Unit:=wdCharacter, Count:=-1004在活动文档的开头插入用制表符分隔的文本，然后将这些文本转换为表格。Sub ConvertExistingText（） With Documents.Add.Content .InsertBefore one vbTab & twothree vbCr .ConvertToTable Separator:=Chr（9）, NumRows:=1, NumColumns:=3005定义一个数组，该数组的元素个数等于文档中第一张表格（

4、假定为 Option Base 1）中的单元格数。For Each.Next 结构用于返回每个表格单元格的内容，并将文字指定给相应的数组元素。Sub ReturnCellContentsToArray（） Dim intCells As Integer Dim strCells（） As String Dim rngText As Range With ActiveDocument.Tables（1）.Range intCells = .Cells.Count ReDim strCells（intCells） For Each celTable In .Cells Set rngText =

5、celTable.Range rngText.MoveEnd Unit: strCells（intCount） = rngText006将当前文档中的表格复制到新文档中。Sub CopyTablesToNewDoc（） Dim docOld As Document Dim rngDoc As Range Dim tblDoc As Table Set docOld = ActiveDocument Set rngDoc = Documents.Add.Range（Start:=0） For Each tblDoc In docOld.Tables tblDoc.Range.Copy With

6、rngDoc .Paste .Collapse Direction:=wdCollapseEnd .InsertParagraphAfter Next007显示 Documents 集合中每个文档的名称。Sub LoopThroughOpenDocuments（） Dim docOpen As Document For Each docOpen In Documents MsgBox docOpen.Name Next docOpen008使用数组存储活动文档中包含的所有书签的名称。Sub LoopThroughBookmarks（） Dim bkMark As Bookmark Dim st

7、rMarks（） As String If ActiveDocument.Bookmarks.Count 0 Then ReDim strMarks（ActiveDocument.Bookmarks.Count - 1） intCount = 0 For Each bkMark In ActiveDocument.Bookmarks strMarks（intCount） = bkMark.Name Next bkMark009更新活动文档中的 DATE 域。Sub UpdateDateFields（） Dim fldDate As Field For Each fldDate In Activ

8、eDocument.Fields If InStr（1, fldDate.Code, Date, 1） Then fldDate.Update Next fldDate010如果名为“Filename”的词条是 AutoTextEntries 集合中的一部分，则以下示例显示一条消息。Sub FindAutoTextEntry（） Dim atxtEntry As AutoTextEntry For Each atxtEntry In ActiveDocument.AttachedTemplate.AutoTextEntries If atxtEntry.Name = Filename Then

9、 _ MsgBox The Filename AutoText entry exists. Next atxtEntry011在第一个表格中添加一行，然后将文本 Cell 插入该行。Sub CountCells（） Dim rowNew As Row Set tblNew = ActiveDocument.Tables（1） Set rowNew = tblNew.Rows.Add（BeforeRow:=tblNew.Rows（1） For Each celTable In rowNew.Cells celTable.Range.InsertAfter Text:012向新文档中添加一个 3

10、行 5 列的表格，然后在表格的每个单元格中插入数据。Sub NewTable（） Dim docNew As Document Dim intX As Integer Dim intY As Integer Set docNew = Documents.Add Set tblNew = docNew.Tables.Add（Selection.Range, 3, 5） With tblNew For intX = 1 To 3 For intY = 1 To 5 .Cell（intX, intY）.Range.InsertAfter Cell: R intX &, C intY Next int

11、Y Next intX .Columns.AutoFit013将 Blue 变量的值设为 6，如果该变量不存在，本示例将该变量添加至文档，并将值设为 6。For Each aVar In ActiveDocument.Variables If aVar.Name = Blue Then num = aVar.IndexNext aVarIf num = 0 Then ActiveDocument.Variables.Add Name:, Value:=6Else ActiveDocument.Variables（num）.Value = 6End If014在文档关闭以前提示用户保存文档。Su

12、b PromptToSaveAndClose（） Dim doc As Document For Each doc In Documents doc.Close SaveChanges:=wdPromptToSaveChanges015若要确定文档是否处于打开状态，可使用 For Each.Next 语句列举 Documents 集合中的元素。如果文档 Sample.doc 是打开的，则下列示例激活该文档，如果没有打开文档，则将该文档打开。Sub ActivateOrOpenDocument（） Dim docFound As Boolean If InStr（1, doc.Name, sam

13、ple.doc, 1） Then doc.Activate docFound = True Exit For Else docFound = False Next doc If docFound = False Then Documents.Open FileName:Sample.doc016第三个多级符号列表模板创建另一种编号样式。Set myTemp = ListGalleries（wdOutlineNumberGallery）.ListTemplates（3）For i = 1 to 9 If i Mod 2 = 0 Then myTemp.ListLevels（i）.NumberSt

14、yle = _ wdListNumberStyleUppercaseRoman wdListNumberStyleLowercaseRomanNext i017将活动文档中每个多级符号列表的编号样式更改为大写字母。For Each lt In ActiveDocument.ListTemplates For Each ll In lt.listlevels ll.NumberStyle = wdListNumberStyleUppercaseLetter Next llNext lt018将活动文档页脚中的页码格式设置为小写罗马数字。For Each sec In ActiveDocument

15、.Sections sec.Footers（wdHeaderFooterPrimary）.PageNumbers _ .NumberStyle = wdPageNumberStyleLowercaseRomanNext sec019显示活动文档各列表的项数。For Each li In ActiveDocument.Lists MsgBox li.CountNumberedItemsNext li020显示活动文档中每个段落的样式。For Each para in ActiveDocument.Paragraphs MsgBox para.StyleNext para021交替设置活动文档中的

16、所有段落为“标题 3”和“正文”样式。For i = 1 To ActiveDocument.Paragraphs.Count ActiveDocument.Paragraphs（i）.Style = wdStyleNormal Else: ActiveDocument.Paragraphs（i）.Style = wdStyleHeading3022显示所选内容中每个字符的样式。Characters 集合的每个元素都是一个 Range 对象。For each c in Selection.Characters MsgBox c.StyleNext c023将从 Normal 模板中删除名为“C

17、ustom 1”的工具栏。Dim cbLoop As CommandBarFor Each cbLoop In CommandBars If cbLoop.Name = Custom 1 Then Application.OrganizerDelete Source:=NormalTemplate.Name, _ Name:, _ Object:=wdOrganizerObjectCommandBarsNext cbLoop024提示用户删除活动文档的相关模板中的每一个“自动图文集”词条。如果用户单击“确定”按钮，则将删除“自动图文集”词条。Dim atEntry As AutoTextEnt

18、ryDim intResponse As IntegerFor Each atEntry In _ ActiveDocument.AttachedTemplate.AutoTextEntries intResponse = _ MsgBox（Do you want to delete the atEntry.Name _ AutoText entry?, vbYesNoCancel） If intResponse = vbYes Then With ActiveDocument.AttachedTemplate Application.OrganizerDelete _ Source:= .P

19、ath & .Name, _=atEntry.Name, _=wdOrganizerObjectAutoText ElseIf intResponse = vbCancel ThenNext atEntry025显示 Word 启动时自动加载的每一加载项的名称。Dim addinLoop as AddInDim blnFound as BooleanblnFound = FalseFor Each addinLoop In AddIns With addinLoop If .Autoload = True Then MsgBox .Name blnFound = TrueNext addinL

20、oopIf blnFound True Then _No add-ins were loaded automatically.026判断名为“Gallery.dot”的加载项是否自动加载。 If InStr（LCase$（addinLoop.Name）, gallery.dot） If addinLoop.Autoload = True Then Msgbox Autoload027为所选内容的第一节的每个页面添加由黑点构成的边框。Dim borderLoop As BorderFor Each borderLoop In Selection.Sections（1）.Borders With

21、borderLoop .ArtStyle = wdArtBasicBlackDots .ArtWidth = 6Next borderLoop028为活动文档中的第一节的每个页面添加由特定图片所构成的边框。With ActiveDocument.Sections（1） .Borders.AlwaysInFront = True For Each borderLoop In .Borders .ArtStyle = wdArtPeople .ArtWidth = 15 Next borderLoopEnd With029如果未将 Word 设置为自动更新链接，则更新活动文档中所有以 OLE 对象

22、形式链接的图形。Dim shapeLoop as ShapeFor Each shapeLoop In ActiveDocument.Shapes With shapeLoop If .Type = msoLinkedOLEObject Then If .LinkFormat.AutoUpdate = False Then .LinkFormat.UpdateNext s030更新活动文档中未被自动更新的域。Dim fieldLoop as FieldFor Each fieldLoop In ActiveDocument.Fields If fieldLoop.LinkFormat.Auto

23、Update = False Then _ fieldLoop.LinkFormat.UpdateNext fieldLoop031在活动文档中的所有居中段落底部应用下边框。For Each para In ActiveDocument.Paragraphs If para.Alignment = wdAlignParagraphCenter Then para.Borders（wdBorderBottom）.LineStyle = wdLineStyleSingle para.Borders（wdBorderBottom）.LineWidth = wdLineWidth300pt032为当前

24、节中的所有页面添加边框。For Each aBorder In Selection.Sections（1）.Borders aBorder.ArtStyle = wdArtBasicBlackDots aBorder.ArtWidth = 6Next aBorder033检查活动文档中的所有样式，如果检查到一个非内置样式，则显示该样式的名称。Dim styleLoop As StyleFor Each styleLoop in ActiveDocument.Styles If styleLoop.BuiltIn = False Then Msgbox styleLoop.NameLocalNext styleLoop034检查应用程序中创建的所有题注标签，如果检查到一个非内置的题注标签，则显示该标签的名称。Dim clLoop As CaptionL