给word2013整篇文档加拼音

发布网友发布时间：2022-04-20 17:07

共1个回答

热心网友时间：2023-08-05 04:32

首先看下完成后的效果

注：中间的点为显示的格式，可以取消显示标记，打印时不会显示

使用宏代码控制，自动将所有文字添加拼音，然后将每个文字后都加上空格实现拼音的分离，（这部分没有找到比较好的办法），另外，下面的代码来自于互联网，仅供学习交流

Sub 批量添加拼音()
    Dim tintTreatingCount As Integer
    Dim tstrCharA As String
    Dim tlngCurPos As Long
    Dim tintA As Integer
    Selection.WholeStory
    tstrText = Selection.Text
    tintTextLength = Selection.Characters.Count
    tintlinestart = 1
    tintTreatingCount = 0
    Selection.GoTo What:=wdGoToHeading, Which:=wdGoToAbsolute, Count:=1
   Selection.MoveRight unit:=wdCharacter, Count:=1, Extend:=wdExtend

    Selection.GoTo What:=wdGoToHeading, Which:=wdGoToAbsolute, Count:=1

    For tintloopx = 1 To tintTextLength

      tlngCurPos = Selection.MoveRight(unit:=wdCharacter, Count:=1, Extend:=wdExtend)

      tstrCharA = Right(Selection.Text, 1)
      If AscW(tstrCharA) < 255 And AscW(tstrCharA) > -255 Then

        If tintTreatingCount > 0 Then
            tintA = Len(Selection.Text)

            SendKeys "{enter}", 2
            Application.Run MacroName:="FormatPhoneticGuide"

            Selection.MoveRight unit:=wdCharacter, Count:=tintA
            tintTreatingCount = 0
        End If

      Else

         tintTreatingCount = tintTreatingCount + 1

      End If

    Next
    '为每个字都加上空格
    Selection.GoTo What:=wdGoToHeading, Which:=wdGoToAbsolute, Count:=1
    'Selection.HomeKey unit:=wdStory
    For tintloopx = 1 To tintTextLength
      Selection.MoveRight unit:=wdCharacter, Count:=1
      Selection.TypeText Text:=" "
    Next


    MsgBox "任务成功完成"
      '  .Range.PhoneticGuide Text:="lǐ", Alignment:= _
       '     wdPhoneticGuideAlignmentOneTwoOne, Raise:=15, FontSize:=8, FontName _
        '    :="宋体"

End Sub