注記内の指定文字を削除する

こちらのｺﾒﾝﾄで、CATIAの質問を頂きました。
CAD Exchanger Cloud - C#ATIA

久々に挑戦しました。

'VBA
'3D注記の指定文字を削除する  by Kantoku

Option Explicit

Sub CATMain()
    Dim keys As Variant '削除対象文字
    keys = Array(".", "_")
    
    '*************
    Dim Doc As PartDocument
    Set Doc = CATIA.ActiveDocument
    
    Dim Pt As Part
    Set Pt = Doc.Part

    Dim msg As String
    
    Dim keysmsg As String 'ﾒｯｾｰｼﾞ用
    keysmsg = "[" & Join(keys, " , ") & "]"
    
    Dim AnnoLst As Collection 'keysを含んだ注記
    Set AnnoLst = GetHasKeysAnnotationLst(Pt.AnnotationSets, keys)
    If AnnoLst.Count < 1 Then
        msg = keysmsg & vbNewLine & "を含んだ [注記] が見つかりませんでした。"
        MsgBox msg
        Exit Sub
    End If
    
    msg = GetAnnotationNames(AnnoLst)
    msg = "以下の[注記]は" & keysmsg & "を含んでいます。" & vbCrLf & _
        msg & vbCrLf & "指定文字を削除しますか?"
    If MsgBox(msg, vbYesNo) = vbNo Then Exit Sub
    Call ReplaceAnnotationText(AnnoLst, keys)
    
    MsgBox "Done"
End Sub

'指定文字の削除
Private Sub ReplaceAnnotationText( _
    ByVal AnnoLst As Collection, _
    ByVal keys As Variant)
    
    Dim reg As Object
    Set reg = GetReg(keys)
    
    Dim anno As Annotation
    Dim match As Object
    
    For Each anno In AnnoLst
        Set match = reg.Execute(anno.Text.Text)
        anno.Text.Text = reg.Replace(anno.Text.Text, "")
    Next
End Sub

'ﾒｯｾｰｼﾞ用名前取得
Private Function GetAnnotationNames( _
    ByVal lst As Collection) As String
    
    GetAnnotationNames = vbNullString
    
    Dim ary() As String
    ReDim ary(lst.Count - 1)
    Dim i As Long
    
    For i = 1 To lst.Count
        ary(i - 1) = lst(i).Name
    Next
    GetAnnotationNames = Join(ary, vbCrLf)
End Function

'指定したKeyを持つ注記の取得
Private Function GetHasKeysAnnotationLst( _
    ByVal annoSets As AnnotationSets, _
    ByVal keys As Variant) As Collection
    
    Dim reg As Object
    Set reg = GetReg(keys)
    
    Dim lst As Collection
    Set lst = New Collection
    Dim i As Long, j As Long
    Dim annos As Annotations
    Dim anno As Annotation
    Dim match As Object
    
    For i = 1 To annoSets.Count
        Set annos = annoSets.Item(i).Annotations
        For j = 1 To annos.Count
            Set anno = annos.Item(j)
            
            If Not anno.Type = "FTA_Text" Then GoTo continue
            
            Set match = reg.Execute(anno.Text.Text)
            
            If match.Count < 1 Then GoTo continue
            
            lst.Add anno
continue:
        Next
    Next
    Set GetHasKeysAnnotationLst = lst
End Function

'正規表現
Private Function GetReg(ByVal keys As Variant) As Object

    Dim reg As Object
    Set reg = CreateObject("VBScript.RegExp")
    
    With reg
        .Pattern = "[" & Join(keys) & "]"
        .IgnoreCase = False
        .Global = True
    End With
    Set GetReg = reg
End Function

最初のkeys配列に削除したい文字(文字列じゃないです)を指定して下さい。
上記ｻﾝﾌﾟﾙでは

こんな状態が

この様になります。