VBA代码如下:
Sub AddPinYin()
Application.ScreenUpdating = False
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
For tintloopx = 1 To tintTextLength
Selection.MoveRight unit:=wdCharacter, Count:=1
Selection.TypeText Text:=" "
Next
Application.ScreenUpdating = True
MsgBox "任务成功完成"
End Sub
源代码在这,我稍微改了几句:如何为整篇word文档加拼音标注 - 拍拍猫脑 - 博客园www.cnblogs.com
我分离出了单独逐字加空格的代码:
Sub XX()
Application.ScreenUpdating = False
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
Selection.GoTo What:=wdGoToHeading, Which:=wdGoToAbsolute, Count:=1
For tintloopx = 1 To tintTextLength
Selection.MoveRight unit:=wdCharacter, Count:=1
Selection.TypeText Text:=" "
Next
Application.ScreenUpdating = True
End Sub
这篇也可以参考:Word自定义宏实现全文拼音标注 - CSDN博客blog.csdn.net
使用VBA批量为Word文档添加拼音注释
这篇博客介绍了如何通过VBA宏来实现批量为Word文档中的每个汉字添加拼音注释。首先展示了完整的VBA代码,包括检查字符并调用内置的`FormatPhoneticGuide`宏来添加拼音。此外,还提供了一个单独的VBA子程序,用于在每个汉字后面插入空格,以帮助区分拼音。通过这两段代码,用户可以方便地为整篇Word文档快速生成拼音标注。
5229

被折叠的 条评论
为什么被折叠?



