[求助]如何让下面的代码重复多次运行？

ssq1109

在编写代码的过程中我已意识到问题极为复杂，要考虑很多因素如：

{eq \f(a,\r(3,b))}

程序要判断第1个“)”属于\r，第2个“)”属于\f。还有可能有更复杂的嵌套。还有其他一些情况要考虑。

对于一般不太复杂的EQ域，我编的代码已能较好地解决问题，如上面有简单嵌套的分式和根式。

现在我又想到一个思路，因为EQ域能被MathType格式化成嵌入式公式（MathType有一个命令，极易批量实现），这种格式化我早就想利用，但因这种格式化不支持全角汉字和符号被我放弃（我春节期间曾发帖询问过解决办法）。

我现在需要解决的问题是：将EQ域中的汉字和全角符号（如≥、ā等）转换成GBK内码值，并在其前加标识“|G”，其后加标识“|”，如：

中→|GD6D0|

≥→|GA1DD|

ā→|GA8A1|

请注意：

1．只将EQ域中的汉字和全角符号改为G内码，EQ域之外的汉字和全角符号一定不要改；

2．转换得到的G内码中涉及英文字母必须要用大写字母。

经过这样处理后，因EQ域中的字符全为ASCII字符，则被MathType格式化时不会被滤掉，其后我就有办法了。

守柔

我想楼主一则急功近利没有通盘解决的思路，有些病急乱投医的感觉了。

我不太明白你为何要使用GBK内码值（十六进制），而不用UNICODE十六进制呢？有区别吗？为什么？

ssq1109

也许版主说的是，主要是先看到EQ域只有那几个开头，常用的更少，无非是作一些简单替换就行了。相互嵌套先也意识到了，也采取了相应措施，但实际测试发现太复杂的情形就难达到完美结果。

至于要使用GBK内码值（十六进制），而不用UNICODE十六进制是因为转换的结果要进入目标软件（BOOK Maker），而它对汉字和全角字符可以那样处理，原意是为了处理一些难于在键盘上输入的字符用的，如“中”字与加了盘外符标志（这里用“()”代替）的“(GD6D0)”是完全等同的（GBK内码中的字母用大写字母也是系统规定了的），故我说的上法是一个变通处理办法。最后得到的原始排版文件除了显示上看上去不太舒服外，但由它生成的结果文件却是完全正确的。

守柔

以下是引用[I]ssq1109[/I]在2006-2-17 19:22:19的发言：[BR]

也许版主说的是，主要是先看到EQ域只有那几个开头，常用的更少，无非是作一些简单替换就行了。相互嵌套先也意识到了，也采取了相应措施，但实际测试发现太复杂的情形就难达到完美结果。

至于要使用GBK内码值（十六进制），而不用UNICODE十六进制是因为转换的结果要进入目标软件（BOOK Maker），而它对汉字和全角字符可以那样处理，原意是为了处理一些难于在键盘上输入的字符用的，如“中”字与加了盘外符标志（这里用“()”代替）的“(GD6D0)”是完全等同的（GBK内码中的字母用大写字母也是系统规定了的），故我说的上法是一个变通处理办法。最后得到的原始排版文件除了显示上看上去不太舒服外，但由它生成的结果文件却是完全正确的。

试试这个： '* ＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋ '* Created By I LOVE YOU WORD!@ExcelHome 2006-2-19 15:59:41 '仅测试于System: Windows NT Word: 11.0 Language: 2052 '№ 0014^The Code CopyIn [标准模块-NewMacros]^' '* －－－－－－－－－－－－－－－－－－－－－－－－－－－－－ Sub Example() Dim TextString As String, i As Integer Dim intLenth As Integer, aChar As String Dim strResult As String TextString = "abc中国人１２３7我们ＡＢＣ" '取得字符串长度 intLenth = VBA.Len(TextString) For i = 1 To intLenth '循环 aChar = VBA.Mid(TextString, i, 1) '取得单字 If VBA.Asc(aChar) < 0 Then '如果为全角字符,其ASC值<0 ' Debug.Print aChar strResult = strResult & aChar & "|G" & GetGBK(aChar) & "|" Else Debug.Print aChar End If Next MsgBox strResult End Sub '---------------------- Function GetGBK(myString As String) As String '此函数适用于单字返回GBK码,若须多字,请用数组循环 Dim myArray() As Byte myArray = VBA.StrConv(myString, vbFromUnicode) GetGBK = VBA.Hex(myArray(0)) & VBA.Hex(myArray(1)) End Function

ssq1109

原来函数这么有用。我要找相关资料好好学一下。 但还有一问题（见附件） tQVXzzBr.rar (3.13 KB, 下载次数: 12)

2006-2-20 10:04 上传

点击文件名下载附件
[求助]如何让下面的代码重复多次运行？

守柔

以下是引用[I]ssq1109[/I]在2006-2-20 10:04:15的发言：[BR]原来函数这么有用。我要找相关资料好好学一下。 但还有一问题（见附件）

为什么要把我难倒呢？ 请把你的最终结果附上来，让网友们也受益一下。 '* ＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋ '* Created By I LOVE YOU WORD!@ExcelHome 2006-2-20 17:19:04 '仅测试于System: Windows NT Word: 11.0 Language: 2052 '№ 0018^The Code CopyIn [ThisDocument-ThisDocument]^' '* －－－－－－－－－－－－－－－－－－－－－－－－－－－－－ Option Explicit Sub GetFieldCode() Dim oEQ As Field, strCode As String, myCode As String Dim intLenth As Integer, aChar As String, i As Integer Application.ScreenUpdating = False '关闭屏幕更新 With ActiveDocument For Each oEQ In .Fields '域中循环 With oEQ If .Type = wdFieldFormula Then '如果是公式域EQ myCode = "" '初始化变量 strCode = .Code.Text '取得域代码 '取得字符串长度 intLenth = VBA.Len(strCode) For i = 1 To intLenth '循环 aChar = VBA.Mid(strCode, i, 1) '取得单字 If VBA.Asc(aChar) < 0 Then '如果为全角字符,其ASC值<0 myCode = myCode & GetGBK(aChar) '字符串累加 Else myCode = myCode & aChar '字符串累加 End If Next .Code.Text = myCode '重写域代码 .Update '更新此域 End If End With Next End With Application.ScreenUpdating = True End Sub '---------------------- Function GetGBK(myString As String) As String '此函数适用于单字返回GBK码,若须多字,请用数组循环 Dim myArray() As Byte myArray = VBA.StrConv(myString, vbFromUnicode) GetGBK = "|G" & VBA.Hex(myArray(0)) & VBA.Hex(myArray(1)) & "|" End Function

ssq1109

GREAT! THANKS A LOT.

并非想有意难倒守柔大侠,是我自觉提的问题很偏很冷,但守柔大侠轻易化解,足见其功力深厚。

小结一下：

在WORD中的公式一般有2种排法：一是用公式编辑器，二是用EQ域，EQ域公式可通过MathType一个命令转换成嵌入式公式，但这种转换不支持全角字符，如将其转换成GBK内码，因是ASCII字符，故MathType能接受，这样再利用MathType的另一转换命令可将这些嵌入式公式转换成多种文本如TEX，及国际数字标准语言MATHML等，这样再进行后续替换及可变通处理了EQ域中的汉字和全角字符。

ssq1109

QUOTE:

以下是引用守柔在2006-2-20 17:21:29的发言：

QUOTE:

以下是引用[I]ssq1109[/I]在2006-2-20 10:04:15的发言：[BR]原来函数这么有用。我要找相关资料好好学一下。
但还有一问题（见附件）

为什么要把我难倒呢？
请把你的最终结果附上来，让网友们也受益一下。
'* ＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋
'* Created By I LOVE YOU WORD!@ExcelHome 2006-2-20 17:19:04
'仅测试于System: Windows NT Word: 11.0 Language: 2052
'№ 0018^The Code CopyIn [ThisDocument-ThisDocument]^'
'* －－－－－－－－－－－－－－－－－－－－－－－－－－－－－
Option Explicit
Sub GetFieldCode()
    Dim oEQ As Field, strCode As String, myCode As String
    Dim intLenth As Integer, aChar As String, i As Integer
    Application.ScreenUpdating = False    '关闭屏幕更新
    With ActiveDocument
        For Each oEQ In .Fields    '域中循环
            With oEQ
                If .Type = wdFieldFormula Then    '如果是公式域EQ
                    myCode = ""    '初始化变量
                    strCode = .Code.Text    '取得域代码
                    '取得字符串长度
                    intLenth = VBA.Len(strCode)
                    For i = 1 To intLenth    '循环
                        aChar = VBA.Mid(strCode, i, 1)    '取得单字
                        If VBA.Asc(aChar) < 0 Then
                            '如果为全角字符,其ASC值<0
                            myCode = myCode & GetGBK(aChar)    '字符串累加
                        Else
                            myCode = myCode & aChar    '字符串累加
                        End If
                    Next
                    .Code.Text = myCode    '重写域代码
                    .Update '更新此域
                End If
            End With
        Next
    End With
    Application.ScreenUpdating = True
End Sub
'----------------------
Function GetGBK(myString As String) As String
'此函数适用于单字返回GBK码,若须多字,请用数组循环
    Dim myArray() As Byte
    myArray = VBA.StrConv(myString, vbFromUnicode)
    GetGBK = "|G" & VBA.Hex(myArray(0)) & VBA.Hex(myArray(1)) & "|"
End Function

如果将16楼的函数部分改为：

Function GetUnicode(myString As String) As String
'此函数适用于单字返回Unicode码,若须多字,请用数组循环
    Dim myArray() As Byte
    myArray = VBA.StrConv(myString, FromUnicode)
    GetUnicode = "|G" & VBA.Hex(myArray(1)) & VBA.Hex(myArray(0)) & "|"
End Function

　　当然要同时将主代码中的“GBK”改为“Unicode”，可将汉字转换成Unicode码值，但我今天遇到了奇事，附件中的分工中有℃、△、÷、⊙四个符号，转换后△和⊙得到的Unicode码值正确，但℃和÷得到的Unicode码值少了第1个字符（都是0），真是怪事，是不是因为首位是0就去掉了，怎样得到完整的4位Unicode码值呢？

52eb2xaI.rar (2.21 KB, 下载次数: 14)

2006-12-1 10:15 上传

点击文件名下载附件
[求助]如何让下面的代码重复多次运行？

守柔

QUOTE:

以下是引用ssq1109在2006-12-1 10:21:38的发言：

如果将16楼的函数部分改为：

Function GetUnicode(myString As String) As String
'此函数适用于单字返回Unicode码,若须多字,请用数组循环
    Dim myArray() As Byte
    myArray = VBA.StrConv(myString, FromUnicode)
    GetUnicode = "|G" & VBA.Hex(myArray(1)) & VBA.Hex(myArray(0)) & "|"
End Function

　　当然要同时将主代码中的“GBK”改为“Unicode”，可将汉字转换成Unicode码值，但我今天遇到了奇事，附件中的分工中有℃、△、÷、⊙四个符号，转换后△和⊙得到的Unicode码值正确，但℃和÷得到的Unicode码值少了第1个字符（都是0），真是怪事，是不是因为首位是0就去掉了，怎样得到完整的4位Unicode码值呢？

我用你的这个代码运行，"FromUNICODE" 因为“VbFromUnicode"常数，根本得不到你附件中的结果，请再检查一下，另外，vbUnicode 将 Ansi 字串转换为 Unicode 而不是VbFromUnicode.

请检查

ssq1109

谢谢守柔大侠！

上面我改后的代码的确在我单位的机上通过得到，因今天未上班，我在另一机上再试确实如您所言不能PASS，我检查并修改函数部分（见下），在WIN XP+OFFICE 2003上PASS，结果如今天的附件（结果中的蓝色是为清晰起见标的色）。

Sub GetFieldCode1()
   
    Dim oEQ As Field, strCode As String, myCode As String
    Dim intLenth As Integer, aChar As String, i As Integer
    Application.ScreenUpdating = False    '关闭屏幕更新
    With ActiveDocument
        For Each oEQ In .Fields    '域中循环
            With oEQ
                If .Type = wdFieldFormula Then    '如果是公式域EQ
                    myCode = ""    '初始化变量
                    strCode = .Code.Text    '取得域代码
                    '取得字符串长度
                    intLenth = VBA.Len(strCode)
                    For i = 1 To intLenth    '循环
                        aChar = VBA.Mid(strCode, i, 1)    '取得单字
                        If VBA.Asc(aChar) < 0 Then
                            '如果为全角字符,其ASC值<0
                            myCode = myCode & GetUnicode(aChar)    '字符串累加
                        Else
                            myCode = myCode & aChar    '字符串累加
                        End If
                    Next
                    .Code.Text = myCode    '重写域代码
                    .Update '更新此域
                End If
            End With
        Next
    End With
    Application.ScreenUpdating = True
End Sub
'----------------------
Function GetUnicode(myString As String) As String
'此函数适用于单字返回Unicode码,若须多字,请用数组循环
    Dim myArray() As Byte
    myArray = VBA.StrConv(myString, vbWide)
    GetUnicode = "|G" & VBA.Hex(myArray(1)) & VBA.Hex(myArray(0)) & "|"
End Function

我将函数部分的“vbWide”改为“vbNarrow”结果是一样的，如改为“vbUnicode”则连汉字的码值也是错的。

q7fv5rKl.rar (2.35 KB, 下载次数: 14)

2006-12-3 10:13 上传

点击文件名下载附件
[求助]如何让下面的代码重复多次运行？