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
|