《循环在WORD+VBA中的应用》.docx
《《循环在WORD+VBA中的应用》.docx》由会员分享,可在线阅读,更多相关《《循环在WORD+VBA中的应用》.docx(38页珍藏版)》请在冰豆网上搜索。
![《循环在WORD+VBA中的应用》.docx](https://file1.bdocx.com/fileroot1/2022-11/16/3354f7f7-6ed8-4f0a-8987-82708ded812c/3354f7f7-6ed8-4f0a-8987-82708ded812c1.gif)
《循环在WORD+VBA中的应用》
循环在WORDVBA中的应用
[001]在活动文档的开头插入一张4列3行的表格。
ForEach...Next结构用于循环遍历表格
中的每个单元格。
在ForEach...Next结构中,InsertAfter方法用于将文字添至表格单元格
(单元格1、单元格2、以此类推)。
SubCreateNewTable()
DimdocActiveAsDocument
DimtblNewAsTable
DimcelTableAsCell
DimintCountAsInteger
SetdocActive=ActiveDocument
SettblNew=_
Range:
=(Start:
=0,End:
=0),NumRows:
=3,_
NumColumns:
=4)
intCount=1
ForEachcelTableIn"Cell"&intCount
intCount=intCount+1
NextcelTable
Format:
=wdTableFormatColorful2,_
ApplyBorders:
=True,ApplyFont:
=True,ApplyColor:
=True
EndSub
[002]在活动文档中第一张表格的第一个单元格中插入文字。
Cell方法返回单独的Cell对
象。
Range属性返回一个Range对象。
Delete方法用于删除现有的文字,而InsertAfter方
法用于插入文字“Cell1,T。
SubInsertTextInCell()
If>=1Then
With
(1).Cell(Row:
=1,Column:
=1).Range
.Delete
.InsertAfterText:
="Cell1,1"
EndWith
EndIf
EndSub
[003]返回并显示文档中第一张表格的第一行中每个单元格的内容。
SubReturnTableText()
DimtblOneAsTable
DimcelTableAsCell
DimrngTableAsRange
SettblOne=
(1)
ForEachcelTableIn
(1).Cells
SetrngTable=(Start:
=_
End:
=-1)
MsgBox
NextcelTable
EndSub
SubReturnCellText()
DimcelTableAsCell
DimrngTableAsRange
SettblOne=
(1)
ForEachcelTableIn
(1).Cells
SetrngTable=
Unit:
=wdCharacter,Count:
=-1
MsgBox
NextcelTable
EndSub
[004]在活动文档的开头插入用制表符分隔的文本,然后将这些文本转换为表格。
SubConvertExistingText()
With.InsertBefore"one"&vbTab&"two"&vbTab&"three"&vbCr
.ConvertToTableSeparator:
=Chr(9),NumRows:
=1,NumColumns:
=3EndWith
EndSub
[005]定义一个数组,该数组的元素个数等于文档中第一张表格(假定为OptionBase1)中
的单元格数。
ForEach...Next结构用于返回每个表格单元格的内容,并将文字指定给相应的数组元素。
SubReturnCellContentsToArray()
DimintCellsAsInteger
DimcelTableAsCell
DimstrCells()AsString
DimintCountAsInteger
DimrngTextAsRange
If>=1Then
With⑴.RangeintCells=.ReDimstrCells(intCells)intCount=1ForEachcelTableIn.CellsSetrngText=
Unit:
=wdCharacter,Count:
=-1strCells(intCount)=rngTextintCount=intCount+1
NextcelTable
EndWith
EndIf
EndSub
[006]将当前文档中的表格复制到新文档中。
SubCopyTablesToNewDoc()
DimdocOldAsDocument
DimrngDocAsRange
DimtblDocAsTable
If>=1Then
SetdocOld=ActiveDocument
SetrngDoc=End:
=0)
ForEachtblDocIn
WithrngDoc
.Paste
.CollapseDirection:
=wdCollapseEnd.InsertParagraphAfter
.CollapseDirection:
=wdCollapseEnd
EndWith
Next
EndIf
EndSub
[007]显示Documents集合中每个文档的名称。
SubLoopThroughOpenDocuments()
DimdocOpenAsDocument
ForEachdocOpenInDocuments
MsgBox
NextdocOpen
EndSub
[008]使用数组存储活动文档中包含的所有书签的名称。
SubLoopThroughBookmarks()
DimbkMarkAsBookmark
DimstrMarks()AsString
DimintCountAsInteger
If>0Then
ReDimstrMarks-1)
intCount=0
ForEachbkMarkIn
strMarks(intCount)=
intCount=intCount+1
NextbkMark
EndIf
EndSub
[009]更新活动文档中的DATE域。
SubUpdateDateFields()
DimfldDateAsField
ForEachfldDateIn
IfInStr(1,,"Date",1)Then
NextfldDate
EndSub
[010]如果名为"Filename"的词条是AutoTextEntries集合中的一部分,则以下示例显示
条消息。
SubFindAutoTextEntry()
DimatxtEntryAsAutoTextEntry
ForEachatxtEntryInIf="Filename"Then_
MsgBox"TheFilenameAutoTextentryexists."
NextatxtEntry
EndSub
[011]在第一个表格中添加一行,然后将文本Cell插入该行。
SubCountCells()
DimtblNewAsTable
DimcelTableAsCell
DimintCountAsInteger
intCount=1
SettblNew=
(1)
SetrowNew=ForEachcelTableIn
Text:
="Cell"&intCount
intCount=intCount+1
NextcelTable
EndSub
[012]向新文档中添加一个3行5列的表格,然后在表格的每个单元格中插入数据。
SubNewTable()
DimdocNewAsDocument
DimtblNewAsTable
DimintXAsInteger
DimintYAsInteger
SetdocNew=
SettblNew=3,5)
WithtblNew
ForintX=1To3
ForintY=1To5
.Cell(intX,intY)."Cell:
R"&intX&",C"&intY
NextintY
NextintX
EndWith
EndSub
[013]将Blue变量的值设为6,如果该变量不存在,本示例将该变量添加至文档,并将值设
为6。
ForEachaVarIn
If="Blue"Thennum=
NextaVar
Ifnum=0Then
Name:
="Blue”,Value:
=6
Else
(num).Value=6
EndIf
[014]在文档关闭以前提示用户保存文档。
SubPromptToSaveAndClose()
DimdocAsDocument
ForEachdocInDocuments
SaveChanges:
=wdPromptToSaveChanges
Next
EndSub
[015]若要确定文档是否处于打开状态,可使用ForEach...Next语句列举Documents集合中的元素。
如果文档是打开的,则下列示例激活该文档,如果没有打开文档,则将该文档打开。
SubActivateOrOpenDocument()
DimdocAsDocument
DimdocFoundAsBoolean
ForEachdocInDocuments
IfInStr(1,,"",1)Then
docFound=True
ExitFor
Else
docFound=False
EndIf
Nextdoc
IfdocFound=FalseThenFileName:
=""
EndSub
[016]第三个多级符号列表模板创建另一种编号样式。
SetmyTemp=ListGalleries(wdOutlineNumberGallery).ListTemplates(3)
Fori=1to9
IfiMod2=0Then
(i).NumberStyle=_
wdListNumberStyleUppercaseRoman
Else
(i).NumberStyle=_
wdListNumberStyleLowercaseRoman
EndIf
Nexti
[017]将活动文档中每个多级符号列表的编号样式更改为大写字母。
ForEachltIn
ForEachllIn
=wdListNumberStyleUppercaseLetter
Nextll
Nextlt
[018]将活动文档页脚中的页码格式设置为小写罗马数字。
ForEachsecIn
(wdHeaderFooterPrimary).PageNumbers_
.NumberStyle=wdPageNumberStyleLowercaseRoman
Nextsec
[019]显示活动文档各列表的项数。
ForEachliIn
MsgBox