[VBA函数]：获取MText中的可用字符（2）

雪山飞狐(lzh)

很早以前贴过一个版本的，当时写完了都有点糊里糊涂的，这个版本是采用栈实现的，层次清晰一些
[Code]
Public Function GetMTextUnformatString(ByVal str As String) As String
'程序功能:按给定的MText字符串返回可用的字符串
On Error Resume Next

    Dim pStrs As New Collection
    Dim pStack As Collection
    Dim n As Integer
    Dim pStr As String
    Dim pEnd As String
   
    str = "{" & str & "}"
    Do While Len(str) > 0
   
        n = IIf(Left(str, 1) = "\", 2, 1)
        pStr = Left(str, n)
        '分割MText字符串为控制字符或单个字符
        
        If pStr = "}" Then
        '遇"}"时出栈，直到"{"
        
            pEnd = pStrs(pStrs.Count)
            Set pStack = New Collection
            pStack.Add "*TlsCad*"
            
            Do While pEnd <> "{"
               
                pStack.Add pEnd, , 1
                pStrs.Remove pStrs.Count
                pEnd = pStrs(pStrs.Count)
               
            Loop
            
            pStrs.Remove pStrs.Count
            pStack.Remove pStack.Count
            
            For Each i In GetRtfString(pStack)
            '调用GetRtfString函数返回可用的字符集合
            
                pStrs.Add i
               
            Next i
            
        Else
        '当前字符入栈
            pStrs.Add Left(str, n)
            
        End If
        
        str = Right(str, Len(str) - n)
        
    Loop
   
    For Each i In pStrs
    '合并字符集合为字符串
        If Len(i) = 2 Then
        '处理\、{、}
            GetMTextUnformatString = GetMTextUnformatString & Right(i, 1)
            
        Else
        
            GetMTextUnformatString = GetMTextUnformatString & i
            
        End If
        
    Next i
   
End Function

Private Function GetRtfString(ByVal stack As Collection) As Collection
'程序功能:按给定的Rtf字符集合返回可用的字符集合

    Dim pStrs As New Collection
    Dim pStr As String, pType As Long
    Dim i, j
   
    For Each i In stack
        
        If Len(i) = 1 Then
        
            pStrs.Add i
            
        ElseIf Len(i) = 2 Then
        
            pType = Asc(UCase(Right(i, 1)))
            
            Select Case pType
            
            Case 85, 92, 123, 125
            '\ or { or } or U
   
                pStrs.Add i
               
            Case 65, 67, 70, 72, 81, 84, 87
            'A or C or F or H or Q or T or W
            
                Do While stack(1) <> ";"
                    stack.Remove 1
                Loop
                stack.Remove 1
               
            Case 76, 79, 80
            'L or O or P
            
            Case 83
            'S
            
                stack.Remove 1
                Do While stack(1) <> ";"
                    If stack(1) <> "^" Then
                        pStrs.Add stack(1)
                    End If
                    stack.Remove 1
                Loop
                stack.Remove 1
               
            Case 126
            '~
            
                pStrs.Add " "
               
            End Select
            
        End If
   
    Next i

    Set GetRtfString = pStrs
   
End Function
[/Code]

测试代码
[Code]
Sub Test()
Dim s As String
s = "{\C3;\{晓\\东\\Cad\\\}{\Lhttp://{\C1;\{www.xdcad.net\}}\l}是一个好网站啊，呵呵}"
Debug.Print GetMTextUnformatString(s)
End Sub
[/Code]

lsjjm

最初由 lzh741206 发布
[B]很早以前贴过一个版本的，当时写完了都有点糊里糊涂的，这个版本是采用栈实现的，层次清晰一些
[Code]
Public Function GetMTextUnformatString(ByVal str As String) As String
'程序功能:按给定的MText字符串返... [/B]

能否解释一下"可用的字符串"?

雪山飞狐(lzh)

一个简单的例子
上面的测试代码返回
晓东Cadhttp://www.xdcad.ne是一个好网站啊，呵呵
就是去除MText的格式字符

darkblue

那如果“可用的字符”中包括了特殊字符，如分数、“%%d”等这些东西，那得到的“可用字符”又会是什么？

雪山飞狐(lzh)

这个函数主要是考虑到MText－》Text的转换，对于%%d或/U+XXXX没做处理，另外还处于测试阶段，希望大家提供一些测试范例，先谢了