Word VBA:我的Find.Replacement命令只会找到目标的第一个实例。为什么?它不会继续发现更多实例。
我的例程应该找到具有指定样式的所有文本,并将其替换为另一种样式。 IT只找到第一个实例。
Function ExecReplaceStyle(strSourceStyle As String, strDestinationStyle As String) As Integer
On Error GoTo ErrorHandler
Dim Rng As Range
Dim ret As Integer
ExecReplaceStyle = 0
Set Rng = docActiveDoc.Range
Rng.Find.ClearFormatting
Rng.Find.Style = ActiveDocument.Styles(strSourceStyle)
Rng.Find.Replacement.ClearFormatting
Rng.Find.Replacement.Style = ActiveDocument.Styles(strDestinationStyle)
With Rng.Find
.Text = ""
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindContinue
.Format = True
.MatchCase = False
.MatchWholeWord = False
.MatchKashida = False
.MatchDiacritics = False
.MatchAlefHamza = False
.MatchControl = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
'Rng.Find.Execute(Replace:=wdReplaceAll)
Rng.Select
Rng.Find.Execute Replace:=wdReplaceAll
ExecReplaceStyle = ret
Exit Function
ErrorHandler:
ExecReplaceStyle = Err.Number
ErrDescription = Err.Description
Resume Next
End Function
答案 0 :(得分:0)
试试这个......
Function ExecReplaceStyle(strSourceStyle As String, strDestinationStyle As String) As Integer
On Error GoTo ErrorHandler
Dim Rng As Range
Dim ret As Integer
ExecReplaceStyle = 0
Set Rng = ActiveDocument.Range
Const sMsgTitle As String = "find and replace style"
If False = StyleExists(strSourceStyle, ActiveDocument) Then
Call MsgBox("Find style missing : " & strSourceStyle, vbCritical, sMsgTitle)
Exit Function
End If
If False = StyleExists(strDestinationStyle, ActiveDocument) Then
Call MsgBox("Replace style missing : " & strDestinationStyle, vbCritical, sMsgTitle)
Exit Function
End If
With Rng.Find
.ClearFormatting
.Replacement.ClearFormatting
.ClearAllFuzzyOptions
.Text = ""
.Style = strSourceStyle
.Replacement.Text = ""
.Replacement.Style = strDestinationStyle
.Forward = True
.Wrap = wdFindContinue
.Format = True
.MatchCase = False
.MatchWholeWord = False
.MatchKashida = False
.MatchDiacritics = False
.MatchAlefHamza = False
.MatchControl = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Rng.Select: Selection.Collapse wdCollapseStart
Do While Rng.Find.Execute = True
Rng.Style = strDestinationStyle: Rng.Collapse wdCollapseEnd
ExecReplaceStyle = ExecReplaceStyle + 1
If Rng.End = ActiveDocument.Range.End - 1 Or Rng.InRange(ActiveDocument.Bookmarks("\endofdoc").Range) = True Then Exit Do
Loop
Exit Function
ErrorHandler:
ExecReplaceStyle = Err.Number
ErrDescription = Err.Description
Resume Next
End Function
Function StyleExists(sStyleName As String, Optional whDoc As Document = Nothing) As Boolean
Dim dsc As String
On Error GoTo ErrHandler:
StyleExists = True
If whDoc Is Nothing Then Set whDoc = ActiveDocument
dsc = whDoc.Styles(sStyleName).Description
Exit Function
ErrHandler:
StyleExists = False
Err.Clear
End Function