循環(huán)在WORD+VBA中的應(yīng)用

1、時磊忖呎 循環(huán)在WORD VBA 中的應(yīng)用 001在活動文檔的開頭插入一張4列3行的表格。For Each.Next結(jié)構(gòu)用于循環(huán)遍歷表格 中的每個單元格。在For Each.Next結(jié)構(gòu)中，InsertAfter方法用于將文字添至表格單元格 (單元格1、單元格2、以此類推)。 Sub CreateNewTable() Dim docActive As Docume nt Dim tblNew As Table Dim celTable As Cell Dim in tCo unt As In teger Set docActive = ActiveDocume nt Set tblNew =

2、docActive.Tables.Add( _ Ran ge:=docActive.Ra nge(Start:=0, En d:=0), NumRows:=3, _ NumColum ns:=4) in tCou nt = 1 For Each celTable In tblNew.Ra nge.Cells celTable.Ra nge.l nsertAfter Cell & in tCou nt in tCou nt = in tCou nt + 1 Next celTable tblNew.AutoFormat Format:=wdTableFormatColorful2, _ Appl

3、yBorders:=True, Apply Fon t:=True, ApplyColor:=True End Sub 002在活動文檔中第一張表格的第一個單元格中插入文字。Cell方法返回單獨的Cell對 象。Range屬性返回一個 Range對象。Delete方法用于刪除現(xiàn)有的文字，而InsertAfter方 法用于插入文字“ Cell 1,1 ”。 Sub In sertText In Cell() If ActiveDocume nt.Tables.Co unt = 1 Then With ActiveDocument.Tables(1).Cell(Row:=1, Column:=1)

4、.Range .Delete n sertAfter Text:=Cell 1,1 End With End If End Sub 003返回并顯示文檔中第一張表格的第一行中每個單元格的內(nèi)容。 Sub ReturnTableText() Dim tbl One As Table Dim celTable As Cell 時磊5說- Dim rn gTable As Range Set tbl One = ActiveDocume nt.Tables(l) For Each celTable In tblO ne.Rows(1).Cells Set rngTable = ActiveDocume

5、nt.Range(Start:=celTable.Range.Start, _ En d:=celTable.Ra nge.E nd - 1) MsgBox rngTable.Text Next celTable End Sub Sub ReturnCellText() Dim tbl One As Table Dim celTable As Cell Dim rn gTable As Range Set tbl One = ActiveDocume nt.Tables(1) For Each celTable In tblO ne.Rows(1).Cells Set rn gTable =

6、celTable.Ra nge rn gTable.MoveE nd Un it:=wdCharacter, Coun t:=-1 MsgBox rngTable.Text Next celTable End Sub 004在活動文檔的開頭插入用制表符分隔的文本，然后將這些文本轉(zhuǎn)換為表格。 Sub Con vertExisti ngText() With Docume nts.Add.Co ntent .InsertBefore one & vbTab & two & vbTab & three & vbCr .Con vertToTable Separator:=Chr(9), NumRow

7、s:=1, NumColu mn s:=3 End With End Sub 005定義一個數(shù)組，該數(shù)組的元素個數(shù)等于文檔中第一張表格(假定為Optio n Base 1 )中 的單元格數(shù)。For Each.Next結(jié)構(gòu)用于返回每個表格單元格的內(nèi)容，并將文字指定給相應(yīng)的 數(shù)組元素。 Sub ReturnCellCo nte ntsToArray() Dim in tCells As In teger Dim celTable As Cell Dim strCells() As Stri ng Dim in tCo unt As In teger Dim rn gText As Range If

8、 ActiveDocume nt.Tables.Co unt = 1 Then With ActiveDocume nt.Tables(1).Ra nge in tCells = .Cells.Cou nt ReDim strCells(i ntCells) in tCou nt = 1 時需Sr彳 For Each celTable In .Cells Set rn gText = celTable.Ra nge rn gText.MoveE nd Un it:=wdCharacter, Coun t:=-1 strCells(i ntCo unt) = rn gText in tCou n

9、t = in tCou nt + 1 Next celTable End With End If End Sub 006將當前文檔中的表格復(fù)制到新文檔中。 Sub CopyTablesToNewDoc() Dim docOld As Docume nt Dim rn gDoc As Range Dim tblDoc As Table If ActiveDocume nt.Tables.Co unt = 1 Then Set docOld = ActiveDocume nt Set rngDoc = Docume nts.Add.Ra nge(Start:=0, En d:=0) For Eac

10、h tblDoc In docOld.Tables tblDoc.Ra nge.Copy With rngDoc P aste .Collapse Direction:=wdCollapseE nd n sertParagraphAfter .Collapse Direction:=wdCollapseE nd End With Next End If End Sub 007顯示Documents集合中每個文檔的名稱。 Sub LoopThroughOpe nDocume nts() Dim docOpe n As Docume nt For Each docOpe n In Docume n

11、ts MsgBox docOpe n. Name Next docOpe n End Sub 008使用數(shù)組存儲活動文檔中包含的所有書簽的名稱。 Sub LoopThroughBookmarks() Dim bkMark As Bookmark 時需Sr彳 Dim strMarks() As Stri ng Dim in tCo unt As In teger If ActiveDocume nt.Bookmarks.Cou nt 0 The n ReDim strMarks(ActiveDocume nt.Bookmarks.Cou nt - 1) in tCou nt = 0 For Ea

12、ch bkMark In ActiveDocume nt.Bookmarks strMarks( in tCo unt) = bkMark.Name in tCou nt = in tCou nt + 1 Next bkMark End If End Sub 009更新活動文檔中的DATE域。 Sub UpdateDateFields() Dim fldDate As Field For Each fldDate In ActiveDocume nt.Fields If InStr(1, fldDate.Code, Date, 1) Then fldDate.Update Next fldDa

13、te End Sub 010如果名為File name”的詞條是 AutoTextE ntries集合中的一部分，則以下示例顯示一 條消息。 Sub Fin dAutoTextE ntry() Dim atxtE ntry As AutoTextE ntry For Each atxtE ntry In ActiveDocume nt.AttachedTemplate.AutoTextE ntries If atxtE ntry.Name = File name The n _ MsgBox The File name AutoText entry exists. Next atxtE ntr

14、y End Sub 011在第一個表格中添加一行，然后將文本Cell插入該行。 Sub Cou ntCells() Dim tblNew As Table Dim rowNew As Row Dim celTable As Cell Dim in tCo unt As In teger in tCou nt = 1 Set tblNew = ActiveDocume nt.Tables(1) Set rowNew = tblNew.Rows.Add(BeforeRow:=tblNew.Rows(1) For Each celTable In rowNew.Cells celTable.Ra n

15、ge.l nsertAfter Text:=Cell & in tCou nt 時需Sr彳 in tCou nt = in tCou nt + 1 Next celTable End Sub 012向新文檔中添加一個3行5列的表格，然后在表格的每個單元格中插入數(shù)據(jù)。 Sub NewTable() Dim docNew As Docume nt Dim tblNew As Table Dim intX As In teger Dim intY As In teger Set docNew = Docume nts.Add Set tblNew = docNew.Tables.Add(Select

16、io n.Ra nge, 3, 5) With tblNew For intX = 1 To 3 For intY = 1 To 5 .Cell(i ntX, i ntY).Ra nge.l nsertAfter Cell: R & intX & , C & intY Next intY Next intX .Colu mn s.AutoFit End With End Sub 013將Blue變量的值設(shè)為 6,如果該變量不存在，本示例將該變量添加至文檔，并將值 設(shè)為6。 For Each aVar In ActiveDocume nt.Variables If aVar.Name = Blu

17、e Then num = aVarn dex Next aVar If num = 0 The n ActiveDocume nt.Variables.Add Name:=Blue, Value:=6 Else ActiveDocume nt.Variables( nu m).Value = 6 End If 014在文檔關(guān)閉以前提示用戶保存文檔。 Sub PromptToSaveA ndClose() Dim doc As Docume nt For Each doc In Docume nts doc.Close SaveCha nges:=wdPromptToSaveCha nges N

18、ext End Sub 時磊忖呎 015若要確定文檔是否處于打開狀態(tài)，可使用For Each.Next語句列舉 Documents集合中 的元素。如果文檔Sample.doc是打開的，則下列示例激活該文檔，如果沒有打開文檔，則 將該文檔打開。 Sub ActivateOrOpe nDocume nt() Dim doc As Docume nt Dim docF ound As Boolea n For Each doc In Docume nts If In Str(1, doc.Name, sample.doc, 1) The n doc.Activate docF ound = True

19、 Exit For Else docF ound = False End If Next doc If docF ound = False Then Docume nts.Ope n FileNamehSample.doc End Sub 016第三個多級符號列表模板創(chuàng)建另一種編號樣式。 Set myTemp = ListGalleries(wdOutli neNumberGallery). ListTemplates(3) For i = 1 to 9 If i Mod 2 = 0 The n myTemp. ListLevels(i).NumberStyle = _ wdListNumbe

20、rStyleUppercaseRoma n Else myTemp. ListLevels(i).NumberStyle = _ wdListNumberStyleLowercaseRoma n End If Next i 017將活動文檔中每個多級符號列表的編號樣式更改為大寫字母。 For Each lt In ActiveDocume nt.ListTemplates For Each ll In lt.listlevels ll.NumberStyle = wdListNumberStyleUppercaseLetter Next ll Next lt 018將活動文檔頁腳中的頁碼格式設(shè)

21、置為小寫羅馬數(shù)字。 For Each sec In ActiveDocume nt.Sect ions sec.Footers(wdHeaderFooterPrimary).PageNumbers _ 時磊忖呎 .NumberStyle = wdPageNumberStyleLowercaseRoma n Next sec 019顯示活動文檔各列表的項數(shù)。 For Each li In ActiveDocume nt.Lists MsgBox li.Cou ntNumberedltems Next li 020顯示活動文檔中每個段落的樣式。 For Each para in ActiveDoc

22、ume nt.Paragraphs MsgBox para.Style Next para 021交替設(shè)置活動文檔中的所有段落為“標題 3”和“正文”樣式。 For i = 1 To ActiveDocume nt. Paragraphs.Co unt If i Mod 2 = 0 The n ActiveDocume nt.Paragraphs(i).Style = wdStyleNormal Else: ActiveDocume nt.Paragraphs(i).Style = wdStyleHeadi ng3 End If Next i 022顯示所選內(nèi)容中每個字符的樣式。Charact

23、ers集合的每個元素都是一個Range對象。 For each c in Select ion. Characters MsgBox c.Style Next c 023將從Normal模板中刪除名為“ Custom 1 ”的工具欄。 Dim cbLoop As Comma ndBar For Each cbLoop In Comma ndBars If cbLoop.Name = Custom 1 The n Applicati on.Organi zerDelete Source:=NormalTemplate.Name, _ Name:=Custom 1, _ Object:=wdOrg

24、a nizerObjectComma ndBars End If Next cbLoop 時需Sr彳 024提示用戶刪除活動文檔的相關(guān)模板中的每一個“自動圖文集”詞條。如果用戶單擊“確 定”按鈕，則將刪除“自動圖文集”詞條。 Dim atE ntry As AutoTextE ntry Dim in tResp onse As In teger For Each atE ntry In _ ActiveDocume nt.AttachedTemplate.AutoTextE ntries in tResp onse = _ MsgBox(Do you want to delete the &

25、atE ntry.Name _ & AutoText en try?, vbYesNoCa ncel) If in tResp onse = vbYes Then With ActiveDocume nt.AttachedTemplate Applicati on.Organi zerDelete _ Source:= .Path & & .Name, _ Name:=atE ntry.Name, _ Object:=wdOrga nizerObjectAutoText End With ElseIf in tResp onse = vbCa ncel The n Exit For End I

26、f Next atE ntry 025顯示W(wǎng)ord啟動時自動加載的每一加載項的名稱。 Dim addi nLoop as AddI n Dim blnFound as Boolea n blnFound = False For Each addi nLoop In AddI ns With addi nLoop If .Autoload = True The n MsgBox .Name blnFound = True End If End With Next addi nLoop If blnFound True The n _ MsgBox No add-i ns were loaded

27、automatically. 026判斷名為“ Gallery.dot ”的加載項是否自動加載。 Dim addi nLoop as AddI n For Each addi nLoop In AddI ns If InStr(LCase$(addinLoop.Name), gallery.dot) 0 Then If addi nLoop.Autoload = True The n Msgbox Autoload 時需忖呎 End If Next addi nLoop 027為所選內(nèi)容的第一節(jié)的每個頁面添加由黑點構(gòu)成的邊框。 Dim borderLoop As Border For Each

28、 borderLoop In Selecti on .Secti on s(1).Borders With borderLoop .ArtStyle = wdArtBasicBlackDots .ArtWidth = 6 End With Next borderLoop 028為活動文檔中的第一節(jié)的每個頁面添加由特定圖片所構(gòu)成的邊框。 Dim borderLoop As Border With ActiveDocume nt.Sectio ns(1) .Borders.Always InFront = True For Each borderLoop In .Borders With bord

29、erLoop .ArtStyle = wdArtPeople .ArtWidth = 15 End With Next borderLoop End With 029如果未將 Word設(shè)置為自動更新鏈接，則更新活動文檔中所有以O(shè)LE對象形式鏈接 的圖形。 Dim shapeLoop as Shape For Each shapeLoop In ActiveDocume nt.Shapes With shapeLoop If .Type = msoL in kedOLEObject The n If .L in kFormat.AutoUpdate = False Then .Lin kForm

30、at.Update End If End If 030更新活動文檔中未被自動更新的域。 Dim fieldLoop as Field For Each fieldLoop In ActiveDocume nt.Fields End With Next s 時磊5說- If fieldLoop. Li nkFormat.AutoUpdate = False The n _ fieldLoop.L in kFormat.Update Next fieldLoop 031在活動文檔中的所有居中段落底部應(yīng)用下邊框。 For Each para In ActiveDocume nt.Paragraphs

31、 If para.Alig nment = wdAlig nParagraphCe nter The n para.Borders(wdBorderBottom).L in eStyle = wdLi neStyleSi ngle para.Borders(wdBorderBottom).L in eWidth = wdL in eWidth300pt End If Next para 032為當前節(jié)中的所有頁面添加邊框。 For Each aBorder In Select ion. Sect ion s(1).Borders aBorder.ArtStyle = wdArtBasicBla

32、ckDots aBorder.ArtWidth = 6 Next aBorder 033檢查活動文檔中的所有樣式，如果檢查到一個非內(nèi)置樣式，則顯示該樣式的名稱。 Dim styleLoop As Style For Each styleLoop in ActiveDocume nt.Styles If styleLoop.BuiltIn = False Then Msgbox styleLoop.NameLocal End If Next styleLoop 034檢查應(yīng)用程序中創(chuàng)建的所有題注標簽，如果檢查到一個非內(nèi)置的題注標簽，則顯示該 標簽的名稱。 Dim clLoop As Capti

33、on Label For Each clLoop in Capti on Labels If clLoop.BuiltIn = False The n Msgbox clLoop.Name End If Next clLoop 035在父節(jié)點中添加子節(jié)點，并在父節(jié)點中顯示文本以代表創(chuàng)建的子節(jié)點數(shù)目。 Sub Cou ntChildNodes() Dim shpDiagram As Shape Dim dgnN ode As DiagramNode 時需Sr彳 Dim shpText As Shape Dim in tCo unt As In teger Add radial diagram t

34、o the curre nt docume nt Set shpDiagram = ThisDocume nt.Shapes.AddDiagram _ (Type:=msoDiagramRadial, Left:=10, _ Top:=15, Width:=400, Height:=475) Add first node to the diagram Set dgnN ode = shpDiagram.DiagramNode.Childre n.AddNode Add three child no des For in tCou nt = 1 To 3 dgnN ode.Childre n.A

35、ddNode Next in tCou nt Add a text box for each node in the diagram For in tCou nt = 1 To 4 Set shpText = shpDiagram.DiagramNode.Childre n(1).TextShape shpText.TextFrame.TextRa nge.Text = Str(i ntCo unt) Next in tCou nt End Sub 036將與活動文檔相關(guān)的模板中的所有“自動圖文集”詞條復(fù)制到Normal模板中。 Dim atE ntry As AutoTextE ntry F

36、or Each atE ntry In _ ActiveDocume nt.AttachedTemplate.AutoTextE ntries Applicati on.Organi zerCopy _ Source:=ActiveDocume nt.AttachedTemplate.FullName, _ Desti natio n:=NormalTemplate.FullName, Name:=atE ntry.Name, _ Object:=wdOrga nizerObjectAutoText Next atE ntry 037如果活動文檔中含有名為“SubText”的樣式，本示例將該樣

37、式復(fù)制到 C:TemplatesTemplate1.dot 中。 Dim styleLoop As Style For Each styleLoop In ActiveDocume nt.Styles If styleLoop = SubText The n Applicatio n.Organi zerCopy Source:=ActiveDocume nt.Name, _ Desti natio n:=C:TemplatesTemplate1.dot, _ Name:=SubText, _ Object:=wdOrga nizerObjectStyles End If Next style

38、Loop 時磊5說- 038顯示各打開文檔的名稱。 For Each aDoc In Docume nts aName = aName & aDoc.Name & vbCr Next aDoc MsgBox aName 039查看Documents集合以判定名為Report.doc”的文檔是否已打開。如果該文檔包含 在Documents集合中，則激活該文檔；否則，打開該文檔。 For Each doc In Docume nts If doc.Name = Report.doc Then found = True Next doc If found True The n Docume nts.

39、Ope n FileName:=C:Docume ntsReport.doc Else Docume nts(Report.doc).Activate End If 040如果FirstLetterExceptions集合包含縮寫addr.，則下列示例將其從中刪除。 For Each aExcept In AutoCorrect.FirstLetterExceptions If aExcept.Name = addr. Then aExcept.Delete Next aExcept 041創(chuàng)建一篇新文檔，然后插入所有的自動更正的首字母例外項。 Docume nts.Add For Each

40、aExcept In AutoCorrect.FirstLetterExceptions With Selectio n n sertAfter aExcept.Name n sertParagraphAfter .Collapse Direction:=wdCollapseE nd End With Next aExcept 042顯示與Windows集合的第一個窗口相關(guān)的窗格中所有的非打印字符。 For Each myPa ne In Win dows(1).Pa nes myPa ne.View.ShowAII = True Next myPa ne 時需Sr彳 043設(shè)置 Window

41、s集合中所有窗口的視圖選項。 For Each myWindow In Win dows With myWin dow.View .ShowTabs = True .ShowParagraphs = True .Type = wdNormalView End With Next myWi ndow 044將包含所選內(nèi)容的節(jié)的格式設(shè)置為三欄。For Each.Next循環(huán)用于顯示 TextColumns 集合中每一列的寬度。 Selectio n.PageSetup.TextColu mn s.SetCo unt NumColu mn s:=3 For Each acol In Selecti

42、on .PageSetup.TextColu mns MsgBox Width= & Poi ntsTol nches(acol.Width) Next acol 045顯示活動文檔中每一個域的域代碼。 Dim fieldLoop As Field For Each fieldLoop In ActiveDocume nt.Fields MsgBox Chr(34) & fieldLoop.Code.Text & Chr(34) Next fieldLoop 046判斷活動文檔中是否包含一個名為“Title ”的郵件合并域。 Dim fieldLoop As Field For Each fi

43、eldLoop In ActiveDocume nt.MailMerge.Fields If In Str(1, fieldLoop.Code.Text, Title, 1) The n MsgBox A Title merge field is in this docume nt End If Next fieldLoop 047如果名為“ acheive”的“自動更正”詞條是AutoCorrectEntries集合的一員，則下列示 例將該詞條刪除。 Sub DeleteAutoTextE ntry() Dim aceE ntry As AutoCorrectE ntry For Each

44、aceE ntry In AutoCorrect.E ntries If aceE ntry.Name = acheive The n aceE ntry.Delete Next aceE ntry End Sub 時磊5說- 048為活動文檔的所有超鏈接創(chuàng)建快捷方式，并將其添加到“收藏夾”文件夾。 For Each myHyperl ink In ActiveDocume nt.Hyperl inks myHyperli nk.AddToFavorites Next myHyperl ink 049為Sales.doc創(chuàng)建快捷方式，并將其添加至“收藏夾”文件夾。如果 Sales.doc還未打

45、 開，本示例將從 C:Documents文件夾打開該文檔。 For Each doc in Docume nts If LCase(doc.Name) = sales.doc Then isOpe n = True Next doc If isOpe n True The n Docume nts.Ope n _ FileName:=C:Docume ntsSales.doc Docume nts(Sales.doc).AddToFavorites 050為活動文檔中第一節(jié)的每個頁面添加單線型邊框，然后設(shè)置每個邊框到頁面邊緣的距 離。 Dim borderLoop As Border With

46、 ActiveDocume nt.Sectio ns(1) For Each borderLoop In .Borders borderLoop.L in eStyle = wdL in eStyleS in gle borderLoop.Li neWidth = wdL in eWidth050pt Next borderLoop With .Borders .Dista nceFrom = wdBorderDista nceFromPageEdge .Dista nceF romTop = 20 .Dista nceFromLeft = 22 .Dista nceF romBottom =

47、 20 .Dista nceFromRight = 22 End With End With 051為所選內(nèi)容的第一節(jié)的每個頁面添加邊框，然后將文本與頁面邊框的距離設(shè)置為6 磅。 Dim borderLoop As Border With Selectio n.Sectio ns(1) For Each borderLoop In .Borders borderLoop.ArtStyle = wdArtSeattle borderLoop.ArtWidth = 22 Next borderLoop With .Borders 時磊忖呎 .Dista nceFrom = wdBorderDist

48、a nceFromText .Dista nceF romTop = 6 .Dista nceF romLeft = 6 .Dista nceFromBottom = 6 .Dista nceF romRight = 6 End With End With 052如果文檔在上次保存后進行了修改，本示例將保存該文檔。 Dim docLoop As Docume nt For Each docLoop In Docume nts If docLoop.Saved = False Then docLoop.Save Next docLoop 053先將文檔的左右邊距設(shè)置為0.5英寸，然后打印所有打開

49、的文檔。 Dim docLoop As Docume nt For Each docLoop In Docume nts With docLoop .PageSetup. LeftMargin = In chesToPoi nts(0.5) .PageSetup.RightMargin = In chesToPoi nts(0.5) .Pri ntOut End With Next docLoop 054刪除活動文檔正文和頁腳中的所有域。 For Each aField in ActiveDocume nt.Fields aField.Delete Next aField Set myRa n

50、ge = ActiveDocume nt.Sectio ns(1).Footers _ (wdHeaderFooterPrimary).Ra nge For Each aField In myRa nge.Fields aField.Delete Next aField 055將底紋應(yīng)用于選定內(nèi)容中每張表格的首行。For Each.Next循環(huán)用于在選定內(nèi)容的每張 表格中循環(huán)。 Sub ShadeAllFirstRows In Tables() Dim tblTable As Table If Selection.Tables.Count = 1 Then For Each tblTable

51、In Select ion. Tables tblTable.Rows(1).Shadi ng.Texture = wdTexture30Perce nt Next tblTable End If End Sub 056在安裝的轉(zhuǎn)換器中循環(huán)，如果發(fā)現(xiàn)WordPerfect 6.0轉(zhuǎn)換器，本示例會使用該轉(zhuǎn)換器保 存活動文檔。 Sub SaveWithCo nverter() Dim cnvWrdPrf As FileCo nverter Look for WordPerfect file con verter And save docume nt using the con verter For

52、 the FileFormat con verter value For Each cn vWrdPrf In Applicati on. FileC on verters If cn vWrdPrf.ClassName = WrdPrfctWi n The n ActiveDocume nt.SaveAs FileName:=MyWP.doc, _ FileFormat:=c nvWrdPrf.SaveFormat End If Next cnvWrdPrf End Sub 057顯示使用密碼保存文檔的過程。 Sub SaveWithPassword(docCurre nt As Docum

53、e nt, strPWD As Stri ng) With docCurre nt .SaveAs WritePassword:=strPWD End With End Sub 058當SpellingSuggestions方法應(yīng)用于 Application 對象時，必須指定要檢查的單詞。 當GetSpellingSuggestions 方法應(yīng)用于一個區(qū)域時，則檢查該區(qū)域的第一個單詞。下例檢 查活動文檔中的任意單詞是否存在拼寫建議。如果有，則在消息框中顯示這些建議。不能 在拼寫建議集合中添加或刪除建議。拼寫建議是從主詞典或自定義詞典中獲取的。 For Each wd In ActiveDocu

54、me nt.Words Set sugg = wd.GetSpelli ngSuggesti ons If sugg.Co unt 0 Then For Each ss In sugg MsgBox ss.Name Next ss End If Next wd 時需Sr彳 059在活動文檔所有文字部分中刪除與主文本部分不同的自定義字符格式。 For Each aStory In ActiveDocume nt.StoryRa nges If aStory.StoryType wdMai nTextStory The n aStory.Fo nt.Reset Next aStory 060在活動

55、文檔的各部分中尋找“Microsoft Word ”，如找到則將其設(shè)置為斜體格式。 For Each myStoryRa nge In ActiveDocume nt.StoryRa nges myStoryRa nge.Fi nd.Execute _ Fi ndText:=Microsoft Word, Forward:=True While myStoryRa nge. Fin d.F ound myStoryRa nge.l talic = True myStoryRa nge.Fi nd.Execute _ Fi ndText:=Microsoft Word, Forward:=Tru

56、e Wend While Not (myStoryRa nge.NextStoryRa nge Is Nothi ng) Set myStoryRa nge = myStoryRa nge.NextStoryRa nge myStoryRa nge.Fi nd.Execute _ Fi ndText:=Microsoft Word, Forward:=True While myStoryRa nge. Fin d.F ound myStoryRa nge.l talic = True myStoryRa nge.Fi nd.Execute _ Fi ndText:=Microsoft Word

57、, Forward:=True Wend Wend Next myStoryRa nge 061包含內(nèi)置“ Normal ”樣式的樣式分隔符的所有段落設(shè)置格式。 Sub StyleSep() Dim pghDoc As Paragraph For Each pghDoc In ThisDocume nt. Paragraphs If pghDocsStyleSeparator = True Then pghDoc.Ra nge.Select Selectio n.Style = Normal End If Next pghDoc End Sub 062在每個樣式分隔符后添加一個段落，然后刪除樣

58、式分隔符。 Sub RemoveStyleSeparator() Dim pghDoc As Paragraph 時磊5說- Dim styName As Stri ng Loop through all paragraphs in docume nt to check if it is a style separator. If it is, delete it and enter a regular paragraph For Each pghDoc In ThisDocume nt. Paragraphs If pghDocsStyleSeparator = True Then pghD

59、oc.Ra nge.Select With Selecti on .Collapse (wdCollapseE nd) .TypeParagraph .MoveLeft (1) .TypeBackspace End With End If Next pghDoc End Sub 063在所選段落中2.5英寸處添加一個制表位，并顯示TabStops集合中每一項目的位置。 Selectio n.Paragraphs.TabStops.Add Positi on :=l nchesToPoi nts(2.5) For Each aTab In Selecti on .Paragraphs.TabSt

60、ops MsgBox Position = _ & PointsTolnches(aTab.Position) & inches Next aTab 064使用Paragraphs集合(或包含多個段落的一個范圍)時，如果集合中各段制表位位置 不一致，就必須在各段中分別修改。下例刪除活動文檔中位于各段1英寸處的制表位。 For Each para In ActiveDocume nt.C onten t.Paragraphs para.TabStops(I nchesToPoi nts(1).CIear Next para 065顯示活動文檔附加的模板中為FileOpen命令指定的所有組合鍵。