[求助]能否用VBA代码实现下列转换?

ssq1109

在早期的方正文件中为解决生僻字(如“镕”)和特殊符号〔如“⊙”、“〇”,此处〇的GBK内码是A996，不是符号○(GBK内码为A1F0)，前者是汉字0的规范用字，有字体变化〕的输入，采用了“盘外符括号（此处用‘( )’代替）＋G＋GBK内码”的方式，这样在文中就会有下面的文字： 朱(GE946)基总理 二(GA996) (GA996)一年 这可能是因早期UNICODE编码的CJK汉字还未大行其道（在CJK 2.0汉字中并无〇，在CJK 3.0中才有〇）而采用的变通之法。前几天我想把一些原方正文件中的文本加进网页中，发现有不少此类GBK代码的汉字和全角符号，一个个转换很麻烦，能否用VBA代码转换？如将上2行字转换成： 朱镕基总理 二〇〇一年 [em09]

konggs

这个行否？

Sub 替换()
Dim arange As Range
Dim array1()
Dim i%
Set arange = ActiveDocument.Content
array1 = Array("GE946", "GA996")
array2 = Array("镕", "〇")
For i = 0 To UBound(array1())
With arange.Find
.ClearFormatting
.MatchWildcards = True
.Text = "\(" & array1(i) & "\)"
.Execute replacewith:=array2(i), Replace:=wdReplaceAll
End With
Next
End Sub

ssq1109

谢谢konggs! 不好意思,说明我未说明白。

我的意思是文中有大量此类字符,不仅仅只这2个,就是说不论是什么汉字或全角字符,只要它用(G+GBK内码)表示的,都将它们替换成对应的汉字或全角字符。

yuyvtul

抛砖引玉

录制宏可以做到，但我不会VBA作循环,哪位大侠将程序改一下，优化、循环，应该一次可以成功。（完成后全选，粘贴——无格式文本)

Selection.Find.ClearFormatting
With Selection.Find
.Text = "(G"
.Replacement.Text = "\1\2"
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchByte = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute
Selection.MoveLeft Unit:=wdCharacter, Count:=1
Selection.MoveRight Unit:=wdCharacter, Count:=7, Extend:=wdExtend
Selection.Fields.Add Range:=Selection.Range, Type:=wdFieldEmpty, _
PreserveFormatting:=False
Selection.TypeText Text:="SYMBOL 0x"
Selection.Delete Unit:=wdCharacter, Count:=1
Selection.Delete Unit:=wdCharacter, Count:=1
Selection.MoveRight Unit:=wdCharacter, Count:=4
Selection.Delete Unit:=wdCharacter, Count:=1
Selection.MoveRight Unit:=wdCharacter, Count:=2
End Sub

[此贴子已经被作者于2006-3-14 20:10:56编辑过]

ssq1109

4楼的网友是调用的域功能吗？我刚才试了一下，好像只对“镕”起作用，且变成了域代码形式。

各位老大如能将GBK内码全部转换成UNICODE码也可以，后面就好办了。

yuyvtul

你没看清楚，我已说了，我不会VBA,不会循环，只能作一个按钮，每次一个——笨。我用了20个，都成功了。
至于域代码方式，完成后全选、复制、粘贴——无格式文本。
按说能用UNICODE码解决，就能用GBK解决，楼主用UNICODE码怎么解决？

守柔

请参考：

'* ＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋

'* Created By I LOVE YOU WORD!@ExcelHome 2006-3-15 19:13:11

'仅测试于System: Windows NT Word: 11.0 Language: 2052

'№ 0032^The Code CopyIn [ThisDocument-ThisDocument]^'

'* －－－－－－－－－－－－－－－－－－－－－－－－－－－－－

Option Explicit

Sub Example()

Dim myString As String

myString = "朱(GE946)基总理二(GA996) (GA996)一年"

MsgBox GetUnicode(myString)

End Sub

'----------------------

Function GetUnicode(strText As String) As String

Dim myString As String, i As Integer, TF As Boolean

Dim intLenth As Integer, aChar As String

intLenth = VBA.Len(strText)

For i = 1 To intLenth

aChar = Mid(strText, i, 1)

If aChar = "(" Then TF = True: aChar = ""

If aChar = ")" Then

TF = False

myString = VBA.Replace(myString, " ", "")

myString = VBA.Mid(myString, 2, Len(myString) - 1)

GetUnicode = GetUnicode & Chr("&H" & myString)

myString = ""

ElseIf TF = True Then

myString = myString & aChar

Else

GetUnicode = GetUnicode & aChar

End If

Next

End Function

ssq1109

非常谢谢守柔大侠!在您的代码的启发下,已解决了我的问题。现在我马上要上班了,有时间我再把解决问题方法贴出来。

ssq1109

为实现我的查找替换要求,将守柔版主的另一处代码进行了改写。

再次感谢守柔大侠!

Sub GBK码2汉字()
Dim myRange As Range, strText As String
Dim myString As String
Application.ScreenUpdating = False '关闭屏幕更新
Set myRange = ActiveDocument.Content '定义一个RANGE对象
strText = "?G*?" '定义要查找的字符串,注意显示的空格为盘外符,是全角符号
FN: With myRange.Find
.ClearFormatting '清除查找格式
.Text = strText '设置查找文本
.MatchWildcards = True '使用通配符
Do While .Execute '如果成功查找
myString = VBA.Replace(myRange.Text, " ", "") '取得查找实例的替换空格的文本内容
myString = VBA.Mid(myString, 3, Len(myString) - 3) '取得从第3个字符开始到最后第2个字符之间的内容
myRange.Text = Chr("&H" & myString) '设置RANGE的TEXT为转为10进制的ASCII文本
Set myRange = ActiveDocument.Content '刷新RANGE对象
GoTo FN '进入下一个查找
Loop
End With
Application.ScreenUpdating = True '恢复屏幕更新
End Sub

下面是我测试的样本之一,运行效率也很高。

?GE946??GF79B??GA8A1??GA1F7??GA1C3??GA6A4??GA6D1??GA996?