如何為整篇word文檔加拼音標注

     4月9日，打印一篇童話，突然想到如果為童話加上標音會更適合小孩閱讀，就試圖為整篇文檔加拼音標注，但結果令我失望，微軟的word加拼音有字數限制，每次只能為幾十個字加拼音標注，如果以這種方式為一篇幾千字的童話加拼音，工作量將會令人無法忍受。為此，我決定為word加一個簡單的宏命令，令這個工作簡單化。
    由於對word宏命令不太熟悉，我將個任務分解為三部分，第一，了解光標的移動指令；第二，了解加拼音的命令；第三，對排版進行一些美化調整。
     第一點並不復雜，簡單錄制一個宏，移動一下光標，就很清楚地看到移動的指令了。
     Selection.MoveRight unit:=wdCharacter, Count:=1, Extend:=wdExtend
     接下來，我在msdn簡單瀏覽了一下selection對象以及一些move前綴的方法，初步了解了一些移動的指令。
    第二點，我右鍵點了下菜單，在自定義菜單中找了“拼音標准”對應的命令FormatPhoneticGuide，以此為關鍵字進行搜索，很快就得到了在宏中使用的簡單調用方法，但這個方法我覺得不科學，如果有軟件處理響應時間跟不上，很容易就會崩潰，但沒找到更好的方法：
    SendKeys "{enter}", 2 ‘模擬鍵盤輸入，2是等待時間，因為加拼音標注的對話框調用在后面，為了正確向它發出回車鍵信息，要等幾秒，事實上這個值越大越安全，但等待時間太長會影響程序的運行效率，這個方法我認為不太好，但沒有找到FormatPhoneticGuide的其它信息，也就將就使用這個笨方法了！    Application.Run MacroName:="FormatPhoneticGuide"
   第三點，為了讓加了拼音后的文字容易閱讀，我決定每個字之間都加上一個空格，否則的話，拼音全擠在一起，會令小孩在拼讀時迷惑，這相當簡單，錄制一個宏，就按一下鍵盤箭頭右移動，然后打個空格就好了，在程序中可以將這個動作循環一下。
   Addpinyin的宏很快就寫好，我一句句單步了一下，沒有什么意外，效果還不錯，直接上結果圖。喜歡的朋友可以也可以看看完整的宏代碼。

              

Sub AddPinYin()
'Author:MissileCat Date:20140410 version:1.0.0
' Addpinyin 宏
'為一篇完整的word文字加上標音標注

    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