Word自定义宏实现全文拼音标注

    最近自学日语，发现word有个拼音加注（拼音指南）的功能，可以很方便的给日文汉字加注假名，正确率也比较高，鸡肋的地方是每次加注的数量有限，而且无法设定默认参数每次都调一下很麻烦，所以想自定义一个宏来实现全文拼音标注。在网上查找了一下，普遍的方法是逐字加注或是以一定字数循环加注，使用这种方法会使得一个词组拆分成几个汉字分别加注假名，导致错误率提高，因此我改为逐句加注的方式。此外，我也没查到word有提供传递参数执行这一功能的方法，因此虽然很笨很麻烦，也是采用模拟按键输入的方法进行调整。

    为方便不懂的人使用，简单讲下使用方法。以word 2013版为例，选择视图选项卡下的宏，在弹出的对话框中随便输入个名字，选择创建宏。然后把以下代码复制进去，保存完成后，可以在宏列表中找到新添加的宏，选中执行即可。附上执行结果：

代码：（注：若想调整字号等，可以修改SendKeys语句中up或down的次数）

Sub 批量加注拼音()
  
   On Error Resume Next
  
   Selection.WholeStory
   TextLength = Selection.Characters.Count
   Selection.EndKey
  
   For i = TextLength To 0 Step -30
      If i <= 30 Then
         Selection.MoveLeft Unit:=wdCharacter, Count:=i
         SelectText = Selection.MoveRight(Unit:=wdCharacter, Count:=i, Extend:=wdExtend)
      Else
     
         Selection.MoveStartUntil
        
         Selection.MoveLeft Unit:=wdCharacter, Count:=30
         SelectText = Selection.MoveRight(Unit:=wdCharacter, Count:=30, Extend:=wdExtend)
      End If
     
        SendKeys "+{tab 3}", 2
        SendKeys "+{s}", 2
        SendKeys "{up 7}", 2
        SendKeys "{down 4}", 2
       
        SendKeys "{tab}", 2
        SendKeys "+{o}", 2
        SendKeys "{up 2}", 2
       
        SendKeys "{enter}", 2
       
        Application.Run "FormatPhoneticGuide"
     
   Next

End Sub

Sub 逐句加注拼音()
  
   Num = ActiveDocument.Sentences.Count
  
   For sen = 1 To Num
  
        ActiveDocument.Sentences(sen).Select
       
        ' 调整字号为8磅
        SendKeys "+{tab 3}", 2
        SendKeys "+{s}", 2
        SendKeys "{up 7}", 2
        SendKeys "{down 4}", 2
       
        ' 调整偏移量为2磅
        SendKeys "{tab}", 2
        SendKeys "+{o}", 2
        SendKeys "{up 2}", 2
       
        ' 确认
        SendKeys "{enter}", 2
       
        Application.Run MacroName:="FormatPhoneticGuide"
  
   Next sen

End Sub

Sub 清除拼音()

' Line:

    Selection.WholeStory
   
    TextLength = Selection.Characters.Count
    Selection.GoTo What:=wdGoToHeading, Which:=wdGoToAbsolute, Count:=1
   
    For i = 0 To TextLength
    
       With Selection
           .Range.PhoneticGuide Text:="", Alignment:=wdPhoneticGuideAlignmentOneTwoOne, Raise:=11, FontSize:=8, FontName:="MS Gothic"
       End With
      
       Selection.MoveRight Unit:=wdCharacter, Count:=1
     
    Next
   
    Selection.WholeStory
   
    ' If Selection.Characters.Count > TextLength Then
    '      GoTo Line
    ' End If
   
End Sub