汉字转拼音的完美解决方案可以更完美，Word版飞快注音

wjhere

简单修改了《汉字转拼音的完美解决方案～[4.5更新]～函数进化》http://club.excelhome.net/viewth ... B4%D2%F4&page=1中的类代码，使之可以正确标注常用的多音字。
使用查找到方法进行，可以过滤无关到字符。
欢迎大家修改代码，看看到底还能有多快！
注意：需要微软拼音输入法2003到支持，微软拼音输入法2007下可能造成程序失去响应！为获得最佳速度，请切换到普通视图。
对汉字转拼音的完美解决方案中的到认知还是极为肤浅的，如果能够再深入了解，让修改后到代码既可以识别多音字，又能够插入空格就更好了。

[ 本帖最后由 wjhere 于 2009-3-21 06:17 编辑 ]

wjhere

谢谢sylun兄，已读过您的短消息。您总是那么委婉，而有是那么及时。让我从一点烛光，看到早晨的太阳。

coby001

Dim S# ' 双精度比较准确
'Dim wL, K As Integer
S = Timer
Application.ScreenUpdating = False  '这句提前了，能节约一点时间
ActiveDocument.ActiveWindow.View.Type = wdNormalView
ActiveDocument.ActiveWindow.View.ShowFieldCodes = False

With ActiveDocument.Content.Find
    .ClearFormatting
    .Text = "[一-﨩]{1,}"     '这句是什么意思？楼主能解释一下吗？
    .MatchWildcards = True
     Do While .Execute
        Set myRr = .Parent
     
'     Word.Application.StatusBar = myRr.Text    '屏蔽了状态栏回显，能节约较多时间


没有做这些小改动前，耗时7秒，之后  耗时 4秒

[ 本帖最后由 coby001 于 2009-3-20 23:40 编辑 ]

sylun

谢谢wjhere兄分享！

wjhere

原帖由 coby001 于 2009-3-20 23:35 发表
Dim S# ' 双精度比较准确
'Dim wL, K As Integer
S = Timer
Application.ScreenUpdating = False  '这句提前了，能节约一点时间
ActiveDocument.ActiveWindow.View.Type = wdNormalView
ActiveDocument.ActiveW ...

谢谢coby001兄支持，这句表示查找一个以上的连续汉字，要使用通配符。"[一-﨩] " 即代表所有的汉字字符，如同"[0-9]"可以代表0-9的数字相关内容参考http://club.excelhome.net/viewth ... hlight=%B2%E9%D5%D2
您的代码的确很快。

冰风萧萧

看不到代码

冰风萧萧

没用微软拼音，9秒，都够快了

coby001

原帖由 冰风萧萧 于 2009-3-21 10:34 发表
没用微软拼音，9秒，都够快了

呵呵   装有office  就默认装有  拼音2003 了，只是你没激活它而已，但它还是起作用的

wjhere

'测试文档为朱自清先生的《春》
'根据sylun兄提供KSPPtoASCII3修改
'sylun兄已经发给我最快的测试文档仅3秒多。（因电脑而异）没有得到授权，不宜公开代码
'得到了论坛朋友们的帮助。这个是原来的改进版，改用倒序查找的方法速度达到5秒。
'2009.3.21 wjhere@126.com
Dim strW As String
Dim strP As String
Dim myR, myRr As Range
Dim S#
Dim wL, K As Integer
S = Timer
On Error Resume Next
Application.ScreenUpdating = False '关闭屏幕刷新
ActiveDocument.ActiveWindow.View.ShowFieldCodes = True '关闭域代码显示

With ActiveDocument.Content.Find
    .ClearFormatting
    .Text = "[一-﨩]{1,}" '查找一个以上的中文字符
    .MatchWildcards = True
    .Forward = False '使用通配符，倒序查找
     Do While .Execute
   
        Set myRr = .Parent '找到的中文字符串区域
        
     wL = myRr.Words.Count
   
        For K = wL To 1 Step -1 '使用倒序标注拼音
            Set myR = myRr.Words(K)
            strW = myR.Text
            strP = HzToPy(strW)
            myR.PhoneticGuide Text:=strP, Alignment:=wdPhoneticGuideAlignmentCenter, _
            Raise:=15, FontSize:=14
            myR.Collapse wdCollapseStart
        Next
         
    myRr.Collapse wdCollapseStart ' 折叠到开头，避免二次查找
    Loop
End With
Set myR = Nothing
Set myRr = Nothing
ActiveDocument.ActiveWindow.View.ShowFieldCodes = False
Application.ScreenUpdating = True
MsgBox "用时 " & Timer - S & " 秒！", vbInformation, "飞快标注音标"

coby001

4 秒  不知道 算不算快？？