word内置命令和VBA编写宏两种方法来实现标点符号之间的全角和半角相互转换

第一,使用word内置的全半角转换   word中全角的标点符号占两个字节,半角的标点符号占一个字节。   在…

第一,使用word内置的全半角转换

  word中全角的标点符号占两个字节,半角的标点符号占一个字节。

  在word2010版提供了包括标点符号、字母、数字综合性的全角半角转换。单击开始——更改大小写命令下面的“半角和全角”,如下图所示:

word标点符号转换

  但此内置功能有一个局限是,如果一个文档同时有数字、字母和标点符号混合,估计用起来,就没有预期想要的效果。

  比如笔者经常需要处理网上的一些资料,往往是夹杂参合一些全角半角的标点符号,为了让整篇文档的标点符号统一为全角或者是统一为半角,就需要进行转换。

  很多朋友的第一想法就是使用word内置的功能,查找替换完成。其实这个方法也是很好的,只是相对繁琐一点。所有的标点符号差不多有27种左右,如果每种标点符号都需要处理一次,就需要进行27次查找替换。

  本文的最终目的是想介绍一个批量转换标点符号的宏来实现全半角转换。

第二,全角标点符号批量转换为半角标点符号

  操作方法如下:
  1.在word中,按ALT+F11组合键,打开VBE编辑器,单击插入——模块,在右边的代码编辑窗口复制下面的代码,并关闭VBE。
  2.回到word编辑界面,选中需要转换的区域,然后单击开发工具——宏(或者按ALT+F8键),打开“宏”对话框,选中“全角转换为半角”宏,单击“运行”命令,即可一次性将选中区域的全角标点符号批量转换为半角标点符号。

标点符号全角半角

  下面是具体的VBA代码,直接复制粘贴sub 至end sub结束的所有代码。

Sub 全角转换为半角()
    \'使用前需先选中要替换的区域
    Dim fullshape, halfshape As String, i As Integer \'定义fullshape(全角)、halfshape(半角)为字符串型,i为整数型
    fullshape = \",。?“”‘’!:;\"
    halfshape = \",.?\"\"\'\'!:;\"
    For i = 1 To 10 \'循环10次
    With Selection.Find
    .Text = Mid(fullshape, i, 1) \'mid函数:返回文本字符串中从指定位置开始的特定数目的字符,每次取一个标点符号
    .Replacement.Text = Mid(halfshape, i, 1) \'将用于替换的相应位置的半角标点符号
    .Format = False \'保留替换前的字符格式
    .Execute Replace:=wdReplaceAll \'用半角标点替换全角标点
    End With
    Next i
    End Sub

第三,半角标点符号批量转换为全角标点符号

  操作方法如下:
  1.在word中,按ALT+F11组合键,打开VBE编辑器,单击插入——模块,在右边的代码编辑窗口复制下面的代码,并关闭VBE。
  2.回到word,按ALT+F8键,打开“宏”对话框,选中“半角标点符号转换为全角标点符号”宏,单击“运行”命令,即可一次性将所有的半角标点符号转换为全角标点符号。

Sub 半角标点符号转换为全角标点符号()
\'中英互译文档中将中文段落中的英文标点符号替换为中文标点符号
    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

关于作者: asdfghjkl

为您推荐

发表回复