循环在WORD+VBA中的应用Word版.docx
《循环在WORD+VBA中的应用Word版.docx》由会员分享,可在线阅读,更多相关《循环在WORD+VBA中的应用Word版.docx(106页珍藏版)》请在冰豆网上搜索。
循环在WORD+VBA中的应用Word版
循环在WORDVBA中的应用
[001]在活动文档的开头插入一张4列3行的表格。
ForEach...Next结构用于循环遍历表格中的每个单元格。
在ForEach...Next结构中,InsertAfter方法用于将文字添至表格单元格(单元格1、单元格2、以此类推)。
SubCreateNewTable()
DimdocActiveAsDocument
DimtblNewAsTable
DimcelTableAsCell
DimintCountAsInteger
SetdocActive=ActiveDocument
SettblNew=docActive.Tables.Add(_
Range:
=docActive.Range(Start:
=0,End:
=0),NumRows:
=3,_
NumColumns:
=4)
intCount=1
ForEachcelTableIntblNew.Range.Cells
celTable.Range.InsertAfter"Cell"&intCount
intCount=intCount+1
NextcelTable
tblNew.AutoFormatFormat:
=wdTableFormatColorful2,_
ApplyBorders:
=True,ApplyFont:
=True,ApplyColor:
=True
EndSub
[002]在活动文档中第一张表格的第一个单元格中插入文字。
Cell方法返回单独的Cell对象。
Range属性返回一个Range对象。
Delete方法用于删除现有的文字,而InsertAfter方法用于插入文字“Cell1,1”。
SubInsertTextInCell()
IfActiveDocument.Tables.Count>=1Then
WithActiveDocument.Tables
(1).Cell(Row:
=1,Column:
=1).Range
.Delete
.InsertAfterText:
="Cell1,1"
EndWith
EndIf
EndSub
[003]返回并显示文档中第一张表格的第一行中每个单元格的内容。
SubReturnTableText()
DimtblOneAsTable
DimcelTableAsCell
DimrngTableAsRange
SettblOne=ActiveDocument.Tables
(1)
ForEachcelTableIntblOne.Rows
(1).Cells
SetrngTable=ActiveDocument.Range(Start:
=celTable.Range.Start,_
End:
=celTable.Range.End-1)
MsgBoxrngTable.Text
NextcelTable
EndSub
SubReturnCellText()
DimtblOneAsTable
DimcelTableAsCell
DimrngTableAsRange
SettblOne=ActiveDocument.Tables
(1)
ForEachcelTableIntblOne.Rows
(1).Cells
SetrngTable=celTable.Range
rngTable.MoveEndUnit:
=wdCharacter,Count:
=-1
MsgBoxrngTable.Text
NextcelTable
EndSub
[004]在活动文档的开头插入用制表符分隔的文本,然后将这些文本转换为表格。
SubConvertExistingText()
WithDocuments.Add.Content
.InsertBefore"one"&vbTab&"two"&vbTab&"three"&vbCr
.ConvertToTableSeparator:
=Chr(9),NumRows:
=1,NumColumns:
=3
EndWith
EndSub
[005]定义一个数组,该数组的元素个数等于文档中第一张表格(假定为OptionBase1)中的单元格数。
ForEach...Next结构用于返回每个表格单元格的内容,并将文字指定给相应的数组元素。
SubReturnCellContentsToArray()
DimintCellsAsInteger
DimcelTableAsCell
DimstrCells()AsString
DimintCountAsInteger
DimrngTextAsRange
IfActiveDocument.Tables.Count>=1Then
WithActiveDocument.Tables
(1).Range
intCells=.Cells.Count
ReDimstrCells(intCells)
intCount=1
ForEachcelTableIn.Cells
SetrngText=celTable.Range
rngText.MoveEndUnit:
=wdCharacter,Count:
=-1
strCells(intCount)=rngText
intCount=intCount+1
NextcelTable
EndWith
EndIf
EndSub
[006]将当前文档中的表格复制到新文档中。
SubCopyTablesToNewDoc()
DimdocOldAsDocument
DimrngDocAsRange
DimtblDocAsTable
IfActiveDocument.Tables.Count>=1Then
SetdocOld=ActiveDocument
SetrngDoc=Documents.Add.Range(Start:
=0,End:
=0)
ForEachtblDocIndocOld.Tables
tblDoc.Range.Copy
WithrngDoc
.Paste
.CollapseDirection:
=wdCollapseEnd
.InsertParagraphAfter
.CollapseDirection:
=wdCollapseEnd
EndWith
Next
EndIf
EndSub
[007]显示Documents集合中每个文档的名称。
SubLoopThroughOpenDocuments()
DimdocOpenAsDocument
ForEachdocOpenInDocuments
MsgBoxdocOpen.Name
NextdocOpen
EndSub
[008]使用数组存储活动文档中包含的所有书签的名称。
SubLoopThroughBookmarks()
DimbkMarkAsBookmark
DimstrMarks()AsString
DimintCountAsInteger
IfActiveDocument.Bookmarks.Count>0Then
ReDimstrMarks(ActiveDocument.Bookmarks.Count-1)
intCount=0
ForEachbkMarkInActiveDocument.Bookmarks
strMarks(intCount)=bkMark.Name
intCount=intCount+1
NextbkMark
EndIf
EndSub
[009]更新活动文档中的DATE域。
SubUpdateDateFields()
DimfldDateAsField
ForEachfldDateInActiveDocument.Fields
IfInStr(1,fldDate.Code,"Date",1)ThenfldDate.Update
NextfldDate
EndSub
[010]如果名为“Filename”的词条是AutoTextEntries集合中的一部分,则以下示例显示一条消息。
SubFindAutoTextEntry()
DimatxtEntryAsAutoTextEntry
ForEachatxtEntryInActiveDocument.AttachedTemplate.AutoTextEntries
IfatxtEntry.Name="Filename"Then_
MsgBox"TheFilenameAutoTextentryexists."
NextatxtEntry
EndSub
[011]在第一个表格中添加一行,然后将文本Cell插入该行。
SubCountCells()
DimtblNewAsTable
DimrowNewAsRow
DimcelTableAsCell
DimintCountAsInteger
intCount=1
SettblNew=ActiveDocument.Tables
(1)
SetrowNew=tblNew.Rows.Add(BeforeRow:
=tblNew.Rows
(1))
ForEachcelTableInrowNew.Cells
celTable.Range.InsertAfterText:
="Cell"&intCount
intCount=intCount+1
NextcelTable
EndSub
[012]向新文档中添加一个3行5列的表格,然后在表格的每个单元格中插入数据。
SubNewTable()
DimdocNewAsDocument
DimtblNewAsTable
DimintXAsInteger
DimintYAsInteger
SetdocNew=Documents.Add
SettblNew=docNew.Tables.Add(Selection.Range,3,5)
WithtblNew
ForintX=1To3
ForintY=1To5
.Cell(intX,intY).Range.InsertAfter"Cell:
R"&intX&",C"&intY
NextintY
NextintX
.Columns.AutoFit
EndWith
EndSub
[013]将Blue变量的值设为6,如果该变量不存在,本示例将该变量添加至文档,并将值设为6。
ForEachaVarInActiveDocument.Variables
IfaVar.Name="Blue"Thennum=aVar.Index
NextaVar
Ifnum=0Then
ActiveDocument.Variables.AddName:
="Blue",Value:
=6
Else
ActiveDocument.Variables(num).Value=6
EndIf
[014]在文档关闭以前提示用户保存文档。
SubPromptToSaveAndClose()
DimdocAsDocument
ForEachdocInDocuments
doc.CloseSaveChanges:
=wdPromptToSaveChanges
Next
EndSub
[015]若要确定文档是否处于打开状态,可使用ForEach...Next语句列举Documents集合中的元素。
如果文档Sample.doc是打开的,则下列示例激活该文档,如果没有打开文档,则将该文档打开。
SubActivateOrOpenDocument()
DimdocAsDocument
DimdocFoundAsBoolean
ForEachdocInDocuments
IfInStr(1,doc.Name,"sample.doc",1)Then
doc.Activate
docFound=True
ExitFor
Else
docFound=False
EndIf
Nextdoc
IfdocFound=FalseThenDocuments.OpenFileName:
="Sample.doc"
EndSub
[016]第三个多级符号列表模板创建另一种编号样式。
SetmyTemp=ListGalleries(wdOutlineNumberGallery).ListTemplates(3)
Fori=1to9
IfiMod2=0Then
myTemp.ListLevels(i).NumberStyle=_
wdListNumberStyleUppercaseRoman
Else
myTemp.ListLevels(i).NumberStyle=_
wdListNumberStyleLowercaseRoman
EndIf
Nexti
[017]将活动文档中每个多级符号列表的编号样式更改为大写字母。
ForEachltInActiveDocument.ListTemplates
ForEachllInlt.listlevels
ll.NumberStyle=wdListNumberStyleUppercaseLetter
Nextll
Nextlt
[018]将活动文档页脚中的页码格式设置为小写罗马数字。
ForEachsecInActiveDocument.Sections
sec.Footers(wdHeaderFooterPrimary).PageNumbers_
.NumberStyle=wdPageNumberStyleLowercaseRoman
Nextsec
[019]显示活动文档各列表的项数。
ForEachliInActiveDocument.Lists
MsgBoxli.CountNumberedItems
Nextli
[020]显示活动文档中每个段落的样式。
ForEachparainActiveDocument.Paragraphs
MsgBoxpara.Style
Nextpara
[021]交替设置活动文档中的所有段落为“标题3”和“正文”样式。
Fori=1ToActiveDocument.Paragraphs.Count
IfiMod2=0Then
ActiveDocument.Paragraphs(i).Style=wdStyleNormal
Else:
ActiveDocument.Paragraphs(i).Style=wdStyleHeading3
EndIf
Nexti
[022]显示所选内容中每个字符的样式。
Characters集合的每个元素都是一个Range对象。
ForeachcinSelection.Characters
MsgBoxc.Style
Nextc
[023]将从Normal模板中删除名为“Custom1”的工具栏。
DimcbLoopAsCommandBar
ForEachcbLoopInCommandBars
IfcbLoop.Name="Custom1"Then
Application.OrganizerDeleteSource:
=NormalTemplate.Name,_
Name:
="Custom1",_
Object:
=wdOrganizerObjectCommandBars
EndIf
NextcbLoop
[024]提示用户删除活动文档的相关模板中的每一个“自动图文集”词条。
如果用户单击“确定”按钮,则将删除“自动图文集”词条。
DimatEntryAsAutoTextEntry
DimintResponseAsInteger
ForEachatEntryIn_
ActiveDocument.AttachedTemplate.AutoTextEntries
intResponse=_
MsgBox("Doyouwanttodeletethe"&atEntry.Name_
&"AutoTextentry?
",vbYesNoCancel)
IfintResponse=vbYesThen
WithActiveDocument.AttachedTemplate
Application.OrganizerDelete_
Source:
=.Path&"\"&.Name,_
Name:
=atEntry.Name,_
Object:
=wdOrganizerObjectAutoText
EndWith
ElseIfintResponse=vbCancelThen
ExitFor
EndIf
NextatEntry
[025]显示Word启动时自动加载的每一加载项的名称。
DimaddinLoopasAddIn
DimblnFoundasBoolean
blnFound=False
ForEachaddinLoopInAddIns
WithaddinLoop
If.Autoload=TrueThen
MsgBox.Name
blnFound=True
EndIf
EndWith
NextaddinLoop
IfblnFound<>TrueThen_
MsgBox"Noadd-inswereloadedautomatically."
[026]判断名为“Gallery.dot”的加载项是否自动加载。
DimaddinLoopasAddIn
ForEachaddinLoopInAddIns
IfInStr(LCase$(addinLoop.Name),"gallery.dot")>0Then
IfaddinLoop.Autoload=TrueThenMsgbox"Autoload"
EndIf
NextaddinLoop
[027]为所选内容的第一节的每个页面添加由黑点构成的边框。
DimborderLoopAsBorder
ForEachborderLoopInSelection.Sections
(1).Borders
WithborderLoop
.ArtStyle=wdArtBasicBlackDots
.ArtWidth=6
EndWith
NextborderLoop
[028]为活动文档中的第一节的每个页面添加由特定图片所构成的边框。
DimborderLoopAsBorder
WithActiveDocument.Sections
(1)
.Borders.AlwaysInFront=True
ForEachborderLoopIn.Borders
WithborderLoop
.ArtStyle=wdArtPeople
.ArtWidth=15
EndWith
NextborderLoop
EndWith
[029]如果未将Word设置为自动更新链接,则更新活动文档中所有以OLE对象形式链接的图形。
DimshapeLoopasShape
ForEachshapeLoopInActiveDocument.Shapes
WithshapeLoop
If.Type=msoLinkedOLEObjectThen
If.LinkFormat.AutoUpdate=FalseThen
.LinkFormat.Update
EndIf
EndIf
EndWith
Nexts
[030]更新活动文档中未被自动更新的域。
DimfieldLoopasField
ForEachfieldLoopInActiveDocument.Fields
IffieldLoop.LinkFormat.AutoUpdate=FalseThen_
fieldLoop.LinkFormat.Update
NextfieldLoop
[031]在活动文档中的所有居中段落底部应用下边框。
ForEachparaInActiveDocument.Paragraphs
Ifpara.Alignment=wdAlignParagraphCenterThen
para.Borders(wdBorderBottom).LineStyle=wdLineStyleSingle
para.Borders(wdBorderBottom).LineWidth=wdLineWidth300pt
EndIf
Nextpara
[032]为当前节中的所有页面添加边框。
ForEachaBorderInSelection.Sections
(1).Borders
aBorder.ArtStyle=wdArtBasicBlackDots
aBorder.ArtWidth=6
NextaBorder
[033]检查活动文档中的所有样式,如果检查到一个非内置样式,则显示该样式的名称。
DimstyleLoopAsStyle
ForEachstyleLoopinActiveDocument.Styles
IfstyleLoop.BuiltIn=FalseThen
MsgboxstyleLoop.NameLocal
EndIf
NextstyleLoop
[034]检查应用程序中创建的所有题注标签,如果检查到一个非内置的题注标签,则显示该标签的名称。
DimclLoopAsCapt