Office: PhoneticGuide: Formatieren und Entfernen über ganzer Markierung

Die PhoneticGuide Funktion gibt mir ein Problem mit der Bearbeitung der FieldCodes (FC) über den gesamten markierten Bereich.
Makros die den phonetischen Text über einem einzelnen Character formatieren/entfernen funktionieren, aber die Durchführung über den gesamten markierten Bereich führt nicht vollständig aus.

Formatieren Einzel:

Code:

Sub PhoneticText_Edit_1chara() ' cursor start from left, cumulative
' select chara and show Field Code and select actual 'FC' code not the entire '{FC}'
    Selection.MoveRight Unit:=wdCharacter, Count:=1, Extend:=wdExtend
    Call PhoneticText_Edit_Single
    Selection.MoveRight Unit:=wdCharacter, Count:=1     ' so it's cumulative
End Sub
    Sub PhoneticText_Edit_Single() ' FC S&R trick to format RubyText
    ' find & select hanzi within the FC to read its size: # of Hanzi size (ps) = # of pinyin size (in hps) = # of raise (in points == offset:=1)
        Selection.Fields.ToggleShowCodes
            With Selection.Find: .Text = "),": .Forward = True: .Wrap = wdFindContinue: End With: Selection.Find.Execute
            Selection.MoveRight Unit:=wdCharacter, Count:=1:    Selection.MoveRight Unit:=wdCharacter, Count:=1, Extend:=wdExtend
            Dim CheckSize As Integer: CheckSize = Selection.Font.Size      ': CheckSize = CheckSize + 1          ' for raise offset +2
            Dim CheckName As String: CheckName = Selection.Font.Name
        Selection.Fields.ToggleShowCodes
    ' format
        Selection.Fields.ToggleShowCodes
        ' replace Font, resize: half of hanzi size, raise: offset, align: Center + disable wildcards again!
            With Selection.Find: .Text = "Font:[A-Za-z0-9]{1,99}": .Replacement.Text = "Font:" & CheckName: .MatchWildcards = True: .Forward = True: .Wrap = wdFindContinue: End With: Selection.Find.Execute Replace:=wdReplaceAll
            With Selection.Find: .Text = "hps[0-9]{1,2}": .Replacement.Text = "hps" & CheckSize: .MatchWildcards = True: .Forward = True: .Wrap = wdFindContinue: End With: Selection.Find.Execute Replace:=wdReplaceAll
            With Selection.Find: .Text = "up [0-9]{1,2}": .Replacement.Text = "up " & CheckSize: .MatchWildcards = True: .Forward = True: .Wrap = wdFindContinue: End With: Selection.Find.Execute Replace:=wdReplaceAll
            With Selection.Find: .Text = "jc2": .Replacement.Text = "jc0": .MatchWildcards = False: .Forward = True: .Wrap = wdFindContinue: End With: Selection.Find.Execute Replace:=wdReplaceAll
        Selection.Fields.ToggleShowCodes
    End Sub

Entfernen Einzel (2 Versionen):

Code:

Sub PhoneticText_Remove_1chara()       ' works either on selected or by preceding cursor, cumulative
    With Selection: .Range.PhoneticGuide Text:="": End With
    Selection.MoveRight Unit:=wdCharacter, Count:=1     ' so it's cumulative
End Sub

Sub PhoneticText_Remove_1chara_v2()    ' preceding cursor, manually grabs chara out of FC and deletes FC, cumulative
    Selection.Fields.ToggleShowCodes
    With Selection.Find: .Text = "),": .Forward = True: .Wrap = wdFindContinue: End With: Selection.Find.Execute
    Selection.MoveRight Unit:=wdCharacter, Count:=1: Selection.MoveRight Unit:=wdCharacter, Count:=1, Extend:=wdExtend
    Selection.Cut
    Selection.Fields.ToggleShowCodes
    Selection.Paste
    Selection.Delete
End Sub

Formatieren über markierten Bereich:
Problem je nach Toggle Plazierung: außerhalb von For-Next Toggle schließt gar kein FC, innerhalb wird nur der FC des ersten Characters geschlossen. Formatierungen wird zwar durchgeführt aber die FCs des Restes bleiben offen.

Code:

Sub PhoneticText_Edit_Selection()    ' wip: outside of For-Next Toggle doesn't close any, inside only first Character in selection, rest are formatted but remain open
    On Error Resume Next
    Dim char As Range, i As Long, OrgSel As Range
    Set OrgSel = Selection                          ' Store the original selection
    For i = 1 To OrgSel.Characters.Count            ' Loop through each character in selection
    Selection.Fields.ToggleShowCodes                ' open FC
        Set char = OrgSel.Characters(i)             ' Get the current character
        char.Select                                 ' Select current character
       ' find & select hanzi within the FC to read its size: # of Hanzi size (ps) = # of pinyin size (in hps) = # of raise (in points == offset:=1)
'            Selection.Fields.ToggleShowCodes
                With Selection.Find: .Text = "),": .Forward = True: .Wrap = wdFindContinue: End With: Selection.Find.Execute
                Selection.MoveRight Unit:=wdCharacter, Count:=1:    Selection.MoveRight Unit:=wdCharacter, Count:=1, Extend:=wdExtend
                Dim CheckSize As Integer: CheckSize = Selection.Font.Size      ': CheckSize = CheckSize + 1          ' for raise offset +2
                Dim CheckName As String: CheckName = Selection.Font.Name
'            Selection.Fields.ToggleShowCodes
        ' format
'            Selection.Fields.ToggleShowCodes
            ' replace Font, resize: half of hanzi size, raise: offset, align: Center + disable wildcards again!
                With Selection.Find: .Text = "Font:[A-Za-z0-9]{1,99}": .Replacement.Text = "Font:" & CheckName: .MatchWildcards = True: .Forward = True: .Wrap = wdFindContinue: End With: Selection.Find.Execute Replace:=wdReplaceAll
                With Selection.Find: .Text = "hps[0-9]{1,2}": .Replacement.Text = "hps" & CheckSize: .MatchWildcards = True: .Forward = True: .Wrap = wdFindContinue: End With: Selection.Find.Execute Replace:=wdReplaceAll
                With Selection.Find: .Text = "up [0-9]{1,2}": .Replacement.Text = "up " & CheckSize: .MatchWildcards = True: .Forward = True: .Wrap = wdFindContinue: End With: Selection.Find.Execute Replace:=wdReplaceAll
                With Selection.Find: .Text = "jc2": .Replacement.Text = "jc0": .MatchWildcards = False: .Forward = True: .Wrap = wdFindContinue: End With: Selection.Find.Execute Replace:=wdReplaceAll
        Selection.Collapse Direction:=wdCollapseEnd ' Deselect the character to move to the next one
    Selection.Fields.ToggleShowCodes                ' close FC
    Next i                                          ' Move to the next character
End Sub

Entfernen über markierten Bereich:
Ähnliches Problem: nur der FC des ersten Characters wird geschlossen, der Rest bleibt offen (bei beiden Versionen):

Code:

Sub PhoneticGuide_Remove_selection_v1()          ' wip only 1st chara in selection done
    Dim char As Range
    With Selection
        For Each char In Selection.Characters
            .Range.PhoneticGuide Text:=""
'           Selection.MoveRight Unit:=wdCharacter, Count:=1    ' does whole doc
        Next char
    End With
End Sub

Sub PhoneticText_Remove_Selection_v2()          ' wip only 1st chara in selection done
    On Error Resume Next
    Dim char As Range, i As Long, OrgSel As Range
    Set OrgSel = Selection                          ' Store original selection
    For i = 1 To OrgSel.Characters.Count
        Set char = OrgSel.Characters(i)             ' Get current character
        char.Select                                 ' Select current character
        With Selection: .Range.PhoneticGuide Text:="": End With
    Next i
End Sub