Sub AddPinYin()

"Author:MissileCat Date:20140410 version:1.0.0

" Addpinyin 宏

"为一篇完整的word文字加上标音标注</p> <p> Dim tintTreatingCount As Integer

Dim tstrCharA As String

Dim tlngCurPos As Long

Dim tintA As Integer</p> <p>

Selection.WholeStory

tstrText = Selection.Text

tintTextLength = Selection.Characters.Count

tintlinestart = 1</p> <p> tintTreatingCount = 0</p> <p> Selection.GoTo What:=wdGoToHeading, Which:=wdGoToAbsolute, Count:=1</p> <p> 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</p> <p> tintTreatingCount = 0</p> <p> End If

Else

tintTreatingCount = tintTreatingCount + 1

End If

Next</p> <p> "为每个字都加上空格

Selection.GoTo What:=wdGoToHeading, Which:=wdGoToAbsolute, Count:=1</p> <p> "Selection.HomeKey unit:=wdStory</p> <p> 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