循环在WORD+VBA中的应用精选文档.docx
《循环在WORD+VBA中的应用精选文档.docx》由会员分享，可在线阅读，更多相关《循环在WORD+VBA中的应用精选文档.docx（108页珍藏版）》请在冰点文库上搜索。
循环在WORD+VBA中的应用精选文档
循环在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］检查应用程序中创建的所有题注标签，如果检查到一个非内置的题注标签，则显示该标签的名称。
DimclLoopAsCapti
升级会员 