Tut mir leid. Aber auch ich kann hier keine Logik mehr erkennen. Endweder das Leerzeichen befindet sich zwischen Anführungszeichen, dann wird es ersetzt, oder wenn nicht, dann eben nicht. Klappt im normalen Word-Fließ-Text soweit ausgezeichnet.
Ohne das Real-Dokument zu kennen, kann ich ab jetzt nur noch mutmaßen. Hast du den Text selbst geschrieben oder aus dem Internet kopiert (Stichwort UTF8). Im Normalfall werden im Word ja Anführungszeichen formatiert dargestellt. „“. Das hab ich im Code entsprechend berücksichtigt. Vieleicht isdt diesen Zeichen 132 und 147 bei dir ein anderes Zeichen zugeordnet. Wenn du sicher bist, dass solche Zeichen niemals vorkommen, kannst du den Code auch etwas vereinfachen und diese Zeilen auskommentieren.
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
a = 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)
b = 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(11) Then x = x + 1
End If
If b > 0 Then
t = drng.Characters(b).Previous
If t <> " " And t <> Chr(13) And t <> Chr(11) Then x = x + 1
End If
InQuotes = x = 2
End Function
Oder dein Dokument ist auf eine Weise aufgebaut, dass rng.Parent.Range nicht mehr den gesamten Text zurückgibt. Probiers in dem Fall mal mit ActiveDocument.Range Aber ob das was bringt weiß ich nicht.
------------------------------------------------------------------------------------
Ansonsten lösche den gesamten Code und versuch es mal mit diesem wesentlich simpleren Ansatz. Der dauert zwar etwas länger, weil er jedes einzelne Zeichen durchläuft, dürfte aber dafür weniger Fehleranfällig sein:
Sub Ersetzen2()
Dim Char As Range
Dim inqt As Boolean
Dim rng As Range
If Selection.Start = Selection.End Then Set rng = ActiveDocument.Range Else Set rng = Selection.Range
For Each Char In rng.Characters
Select Case Char
Case Chr(34)
If inqt = False Then inqt = True Else inqt = False
Case Chr(132)
inqt = True
Case Chr(147)
inqt = False
Case " "
If inqt Then Char = "_"
End Select
Next Char
End Sub
Gruß Mr. K.
|