有没有给大批量中文加拼音的宏？

w597177842

最近有个需求是个大批量的中文加拼音，约2000个量，网上看到几种方法：
1、复制到word中，利用word加拼音，但是word每次只能加很少量的拼音，不能一次全部完成；
2、利用VBA，GETPY和PINYIN宏都有用过，但是都有个问题，很多字无法识别，要么不翻译，保留中文状态，要么翻译成zuo，也不能完全满足需求；
想跟大家请教一下有没有比较全的加拼音的宏可以分享？或者其他方法可以比较好解决这些问题，谢谢！

zpy2

但是word每次只能加很少量的拼音，不能一次全部完成；
?

http://club.excelhome.net/forum.php?mod=viewthread&tid=1552911&mobile=

w597177842

zpy2 发表于 2020-8-26 12:31
但是word每次只能加很少量的拼音，不能一次全部完成；
?

word里，全选文字，添加拼音，每次只能给40个左右的汉字添加拼音，是我操作不对吗？

zpy2

w597177842 发表于 2020-8-26 13:33
word里，全选文字，添加拼音，每次只能给40个左右的汉字添加拼音，是我操作不对吗？

https://m.kafan.cn/edu/6682616.html

需要 宏。。。
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