Habe ich den Code so richtig korrigiert?
Sub Ersetzen()
Dim s As Long, e As Long
s = Selection.Start: e = Selection.End
vTextFN = " "
With Selection.Find
.Text = vTextFN
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
Do
.Execute
If .Found And InQuotes(.Parent.Range) And .Parent.Start >= s And .Parent.End <= e Then
.Parent.Text = "_"
.Parent.Collapse wdCollapseEnd
End If
Loop Until .Found = False
End With
End Sub
Function InQuotes(rng As Range) As Boolean
Dim drng As Range, t As String
Set drng = rng.Parent.Range
Dim a As Long, a1 As Long, a2 As Long, a3 As Long, b As Long, b1 As Long, b2 As Long, b3 As Long, x As Byte
a1 = InStrRev(drng.Text, Chr(34), rng.Start + 1)
a2 = InStrRev(drng.Text, Chr(132), rng.Start + 1)
a3 = InStrRev(drng.Text, Chr(147), rng.Start + 1)
a = IIf(a2 > a1, a2, a1)
a = IIf(a3 > a, 0, a)
b1 = InStr(rng.Start + 1, drng.Text, Chr(34))
b2 = InStr(rng.Start + 1, drng.Text, Chr(147))
b3 = InStr(rng.Start + 1, drng.Text, Chr(132))
b = IIf(b2 < b1 And b2 > 0 Or b1 = 0, b2, b1)
b = IIf(b3 < b And b3 > 0, 0, b)
If a > 0 Then
t = drng.Characters(a).Next
If t <> " " And t <> Chr(13) And t <> Chr(10) Then x = x + 1
End If
If b > 0 Then
t = drng.Characters(b).Previous
If t <> " " And t <> Chr(13) And t <> Chr(10) Then x = x + 1
End If
InQuotes = x = 2
End Function
|