ExcelHome技术论坛

 找回密码
 免费注册

QQ登录

只需一步,快速开始

快捷登录

搜索
EH技术汇-专业的职场技能充电站 妙哉!函数段子手趣味讲函数 Excel服务器-会Excel,做管理系统 效率神器,一键搞定繁琐工作
HR薪酬管理数字化实战 Excel 2021函数公式学习大典 Excel数据透视表实战秘技 打造核心竞争力的职场宝典
让更多数据处理,一键完成 数据工作者的案头书 免费直播课集锦 ExcelHome出品 - VBA代码宝免费下载
用ChatGPT与VBA一键搞定Excel WPS表格从入门到精通 Excel VBA经典代码实践指南
查看: 25814|回复: 24

[原创] 中英标点转换

[复制链接]

TA的精华主题

TA的得分主题

发表于 2005-5-20 05:35 | 显示全部楼层 |阅读模式
本帖最后由 kqbt 于 2012-7-19 08:31 编辑

说明:由于输入法切换等问题,中英文的标点符号在WORD中的替换,一直没有很好地由代码进行.这次应网友要求,作了一个比较详尽的替换方案.


1.         中文标点符号范围(非全部):


"。", ",", ";", ":", "?", "!", "……", "—", "~", "〔", "〕", "《", "》", "‘", "’", "“", "”"共17个


2.         英文标点符号范围(非全部),对应中文标点符号:


".", ",", ";", ":", "?", "!", "…", "-", "~", "(", ")", "<", ">", "'", "'", """", """"


最后四个相当于',',",".


3.         在本方案中,制作了三个宏过程:


a)        ReplaceEnglishInterpunctionInChinese:适用于中英互译文章中的中文段落中的英文标点符号自动全部转化为中文标点符号(是不是有些绕口),您可能需要注意的是,中文段落的起始字符必须为中文汉字,不得为空格等,以示区分.简体中文的ASCII码在-2050到-20319之间,这是代码运行的判断依据.


b)        ReplaceInStoryChinese:适用于全文档的英文标点符号替换为中文标点符号.即不再区分英文段落还是中文段落.


c)        ReplaceChineseInterpunctionInEnglish:全中文标点符号替换为英文标点符号.


4.        注意事项:


如果对于中大型文字文档(如中英互译书籍),第一个代码运行时,需要较高电脑配置和一定运行时间.实点显示:电脑配置:P4,1.8G,256M,WINDOWS2000,OFFICE XP ,处理文档大小:465K,总页数43页.运行时间8分钟.您可能需要关闭所有与程序运行无关的窗口.


相关链接http://club.excelhome.net/viewthread.php?tid=98760


如果您还有一些特殊要求,我也可以另行设计代码(主体结构相似,或许您可以直接修改代码)


以下代码供参考:


'* +++++++++++++++++++++++++++++
'* Created By I Love You_Word!@ExcelHome 2005-5-20 5:30:30
'仅测试于System: Windows NT Word: 10.0 Language: 2052
'^The Code CopyIn [ThisDocument-ThisDocument]^'
'* -----------------------------


Sub ReplaceEnglishInterpunctionInChinese()
'中英互译文档中将中文段落中的英文标点符号替换为中文标点符号
    Dim i As Paragraph, ChineseInterpunction() As Variant, EnglishInterpunction() As Variant
    Dim MyRange As Range, N As Byte
    '定义一个中文标点的数组对象
    ChineseInterpunction = Array("。", ",", ";", ":", "?", "!", "……", "—", "~", "〔", "〕", "《", "》", "‘", "’", "“", "”")
    '定义一个英文标点的数组对象
    EnglishInterpunction = Array(".", ",", ";", ":", "?", "!", "…", "-", "~", "(", ")", "<", ">", "'", "'", """", """")
    On Error Resume Next
    Application.ScreenUpdating = False    '关闭屏幕更新
    For Each i In ThisDocument.Paragraphs    '遍历文档每个段落
        If Asc(i.Range) < 0 Then    '如果段落首个字符为汉字(汉字字符的ASC<0)
            '定义一个RANGE对象
            For N = 0 To 13    '进行14次循环
                Set MyRange = i.Range    '定义一个RANGE对象
                With MyRange.Find    '查找
                    .ClearFormatting    '清除查找格式
                    '查找相应的英文标点,替换为对应的中文标点
                    .Execute findtext:=EnglishInterpunction(N), replacewith:=ChineseInterpunction(N), Replace:=wdReplaceAll
                End With
            Next
        End If
    Next
    Selection.HomeKey wdStory
    With Selection.Find
        .ClearFormatting    '清除查找格式
        .Text = """"    '查找"
        '如果查找成功并且在中文段落中,分别将其替换为“/”
        While .Execute
            If Asc(Selection.Paragraphs(1).Range) < 0 Then Selection.Text = "“"
            If .Execute And Asc(Selection.Paragraphs(1).Range) < 0 Then Selection.Text = "”"
        Wend
    End With
    Selection.HomeKey wdStory
    With Selection.Find
        .ClearFormatting    '清除查找格式
        .Text = "'"    '查找'
        While .Execute
            '如果查找成功并且在中文段落中,分别将其替换为‘/’
            If Asc(Selection.Paragraphs(1).Range) < 0 Then Selection.Text = "‘"
            If .Execute And Asc(Selection.Paragraphs(1).Range) < 0 Then Selection.Text = "’"
        Wend
    End With
    '恢复屏幕更新
    Application.ScreenUpdating = True
End Sub
'----------------------
Sub ReplaceInStoryChinese()
'全中文段落英文标点符号替换为中文标点符号
    Dim i As Paragraph, ChineseInterpunction() As Variant, EnglishInterpunction() As Variant
    Dim N As Byte
    '定义一个中文标点的数组对象
    ChineseInterpunction = Array("。", ",", ";", ":", "?", "!", "……", "—", "~", "〔", "〕", "《", "》", "‘", "’", "“", "”")
    '定义一个英文标点的数组对象
    EnglishInterpunction = Array(".", ",", ";", ":", "?", "!", "…", "-", "~", "(", ")", "<", ">", "'", "'", """", """")
    On Error Resume Next
    Application.ScreenUpdating = False    '关闭屏幕更新
    With ThisDocument.Content.Find
        For N = 0 To 13    '进行14次循环
            .ClearFormatting    '清除查找格式
            '查找相应的英文标点,替换为对应的中文标点
            .Execute findtext:=EnglishInterpunction(N), replacewith:=ChineseInterpunction(N), Replace:=wdReplaceAll
        Next
    End With
    Selection.HomeKey wdStory    '移到文档首
    With Selection.Find
        .ClearFormatting    '清除查找格式
        .Text = """"    '查找"
        '如果查找成功并且在中文段落中,分别将其替换为“/”
        While .Execute: Selection.Text = "“"
            .Execute: Selection.Text = "”"
        Wend
    End With
    Selection.HomeKey wdStory
    With Selection.Find
        .ClearFormatting    '清除查找格式
        .Text = "'"    '查找'
        '如果查找成功并且在中文段落中,分别将其替换为‘/’
        While .Execute: Selection.Text = "‘"
            .Execute: Selection.Text = "’"
        Wend
    End With
    '恢复屏幕更新
    Application.ScreenUpdating = True
End Sub
'----------------------
Sub ReplaceChineseInterpunctionInEnglish()
'全中文标点符号替换为英文标点符号
    Dim ChineseInterpunction() As Variant, EnglishInterpunction() As Variant, N As Byte
    '定义一个中文标点的数组对象
    ChineseInterpunction = Array("。", ",", ";", ":", "?", "!", "……", "—", "~", "〔", "〕", "《", "》", "‘", "’", "“", "”")
    '定义一个英文标点的数组对象
    EnglishInterpunction = Array(".", ",", ";", ":", "?", "!", "…", "-", "~", "(", ")", "<", ">", "'", "'", """", """")
    On Error Resume Next
    MsgBox UBound(EnglishInterpunction)
    Application.ScreenUpdating = False    '关闭屏幕更新
    With ThisDocument.Content.Find
        For N = 0 To 16    '进行14次循环
            .ClearFormatting    '清除查找格式
            '查找相应的英文标点,替换为对应的中文标点
            .Execute findtext:=ChineseInterpunction(N), replacewith:=EnglishInterpunction(N), Replace:=wdReplaceAll
        Next
    End With
    '恢复屏幕更新
    Application.ScreenUpdating = True
End Sub
'----------------------

naYZaV2z.rar (14.68 KB, 下载次数: 620)


[此贴子已经被konggs于2007-4-16 13:07:51编辑过]

评分

1

查看全部评分

TA的精华主题

TA的得分主题

发表于 2005-5-20 10:44 | 显示全部楼层
[广告] Excel易用宝 - 提升Excel的操作效率 · Excel / WPS表格插件       ★免费下载 ★       ★ 使用帮助

一直赞赏守柔先生的编程研究,可惜无力跟进。

有一种现象,就是中文文本中有的数字中有千位分隔符,千万不敢换成全角的了。代码看不太懂,如果有这个问题,建议完善一下。

TA的精华主题

TA的得分主题

发表于 2007-2-19 10:54 | 显示全部楼层
[广告] Excel易用宝 - 提升Excel的操作效率 · Excel / WPS表格插件       ★免费下载 ★       ★ 使用帮助
xuexi,学习!

TA的精华主题

TA的得分主题

发表于 2007-4-16 12:08 | 显示全部楼层
[广告] Excel易用宝 - 提升Excel的操作效率 · Excel / WPS表格插件       ★免费下载 ★       ★ 使用帮助
好!谢谢!

TA的精华主题

TA的得分主题

发表于 2007-4-16 13:07 | 显示全部楼层

TA的精华主题

TA的得分主题

发表于 2007-4-16 15:43 | 显示全部楼层

TA的精华主题

TA的得分主题

发表于 2007-5-5 10:55 | 显示全部楼层
[广告] Excel易用宝 - 提升Excel的操作效率 · Excel / WPS表格插件       ★免费下载 ★       ★ 使用帮助
好啊

TA的精华主题

TA的得分主题

发表于 2007-5-5 11:54 | 显示全部楼层
ms-word灵感百宝箱中有专门工具!

TA的精华主题

TA的得分主题

发表于 2008-4-3 11:27 | 显示全部楼层

TA的精华主题

TA的得分主题

发表于 2008-4-6 16:31 | 显示全部楼层

看不懂,唉,努力,努力再努力

[em30]
您需要登录后才可以回帖 登录 | 免费注册

本版积分规则

手机版|关于我们|联系我们|ExcelHome

GMT+8, 2024-11-24 01:15 , Processed in 0.051878 second(s), 12 queries , Gzip On, MemCache On.

Powered by Discuz! X3.4

© 1999-2023 Wooffice Inc.

沪公网安备 31011702000001号 沪ICP备11019229号-2

本论坛言论纯属发表者个人意见,任何违反国家相关法律的言论,本站将协助国家相关部门追究发言者责任!     本站特聘法律顾问:李志群律师

快速回复 返回顶部 返回列表