豆沙麻球:中英标点转换

中英标点转换

http://club.excelhome.net/viewthread.php?tid=99049

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
'----------------------