彰化一整天的論壇

 找回密碼
 立即註冊
查看: 627|回復: 0

Using a macro to replace text where ever it appears in a document

[複製鏈接]
發表於 2014-10-21 14:52:54 | 顯示全部樓層 |閱讀模式
http://word.mvps.org/faqs/customization/ReplaceAnywhere.htm
  1. Public Sub FindReplaceAnywhere()
  2.   Dim rngStory As Word.Range
  3.   Dim pFindTxt As String
  4.   Dim pReplaceTxt As String
  5.   Dim lngJunk As Long
  6.   Dim oShp As Shape
  7.   pFindTxt = InputBox("Enter the text that you want to find." _
  8.     , "FIND" )
  9.   If pFindTxt = "" Then
  10.     MsgBox "Cancelled by User"
  11.     Exit Sub
  12.   End If
  13.   TryAgain:
  14.   pReplaceTxt = InputBox( "Enter the replacement." , "REPLACE" )
  15.   If pReplaceTxt = "" Then
  16.     If MsgBox( "Do you just want to delete the found text?", _
  17.      vbYesNoCancel) = vbNo Then
  18.       GoTo TryAgain
  19.     ElseIf vbCancel Then
  20.       MsgBox "Cancelled by User."
  21.       Exit Sub
  22.     End If
  23.   End If
  24.   'Fix the skipped blank Header/Footer problem
  25.   lngJunk = ActiveDocument.Sections( 1 ).Headers( 1 ).Range.StoryType
  26.   'Iterate through all story types in the current document
  27.   For Each rngStory In ActiveDocument.StoryRanges
  28.     'Iterate through all linked stories
  29.     Do
  30.       SearchAndReplaceInStory rngStory, pFindTxt, pReplaceTxt
  31.       On Error Resume Next
  32.       Select Case rngStory.StoryType
  33.       Case 6 , 7 , 8 , 9 , 10 , 11
  34.         If rngStory.ShapeRange.Count > 0 Then
  35.           For Each oShp In rngStory.ShapeRange
  36.             If oShp.TextFrame.HasText Then
  37.               SearchAndReplaceInStory oShp.TextFrame.TextRange, _
  38.                   pFindTxt, pReplaceTxt
  39.             End If
  40.           Next
  41.         End If
  42.       Case Else
  43.         'Do Nothing
  44.       End Select
  45.       On Error GoTo 0
  46.       'Get next linked story (if any)
  47.       Set rngStory = rngStory.NextStoryRange
  48.     Loop Until rngStory Is Nothing
  49.   Next
  50. End Sub
  51. Public Sub SearchAndReplaceInStory(ByVal rngStory As Word.Range, _
  52.     ByVal strSearch As String , ByVal strReplace As String )
  53.   With rngStory.Find
  54.     .ClearFormatting
  55.     .Replacement.ClearFormatting
  56.     .Text = strSearch
  57.     .Replacement.Text = strReplace
  58.     .Wrap = wdFindContinue
  59.     .Execute Replace:=wdReplaceAll
  60.   End With
  61. End Sub
複製代碼



回復

使用道具 舉報

您需要登錄後才可以回帖 登錄 | 立即註冊

本版積分規則

 ㄚ母滴雞湯
 員林香純滴雞精

Archiver|手機版|小黑屋|彰化一整天的論壇(Excel,Office)  |网站地图

GMT+8, 2018-7-22 12:22 , Processed in 0.129891 second(s), 9 queries , Apc On.

Powered by Discuz! X3.2

© 2001-2013 Comsenz Inc.

快速回復 返回頂部 返回列表