恭请高手帮忙优化Word自动标注拼音的VBS脚本

subrc · 发表于昨天 17:43

本帖最后由 subrc 于 2026-3-11 23:36 编辑

Option Explicit
Sub PinYin_New()
'Word自动标注拼音:格式-中文版式-拼音指南
'Word格式:必须为纯文本格式:无格式文本/无格式的Unicode文本
'标注原理:模拟运行Word内置宏"FormatPhoneticGuide"
'注意事项:运行期间,拼音指南窗口频繁闪烁,请耐心等待脚本运行完毕,中途请勿切换窗口
'汉字范围的扩展:
'常用范围：\u4e00-\u9fa5（约2万多汉字）--[一-龥]
'扩展范围：\u3400-\u4dbf（扩展A区）和 \u4e00-\u9fff（更完整的常用区）
'大多数情况下，使用 \u4e00-\u9fa5 或 [一-龥] 就足够了
'变量声明（全部显式声明，调整类型为 Long 避免溢出）
Dim Block As String
Dim Ch As String
Dim CharCount As Long
Dim CnCount As Long
Dim CursorPos As Long
Dim DocRange As Range
Dim FullText As String
Dim HasChinese As Boolean
Dim Hz_Font As String
Dim Hz_hps0 As String
Dim Hz_Size As String
Dim I As Long
Dim J As Long
Dim LastChar As String
Dim Loops As Long
Dim Num As Long
Dim Py_Font As String
Dim Py_jc00 As String
Dim Py_Size As String
Dim Rng As Range
Dim Speed As Single
Dim SubLength As Long
Dim Time0 As Single
Dim Time1 As Single
Dim Time2 As Single
'设置拼音格式:字体=等线/字号=8/对齐方式=居中
Hz_Font = "楷体" '汉字字体
Py_Font = "等线" '拼音字体
Hz_Size = "22" '汉字字号=二号(22磅)
Py_Size = "hps16" '拼音域代码字号=hps16(8磅)
Hz_hps0 = "hps" & Hz_Size '汉字域代码字号=hps22(22磅)
Py_jc00 = "jc0" '拼音对齐=jc0(居中)
'设置全文字体字号:字体=楷体,字号=二号(22磅)
Selection.HomeKey Unit:=wdStory '移动光标到全文开头
Selection.WholeStory '全选
Selection.Font.Name = Hz_Font '全文字体
Selection.Font.Size = Hz_Size '全文字号
'关闭域代码、禁用屏幕刷新
ActiveWindow.View.ShowFieldCodes = False '关闭域代码:Alt+F9切换
Application.ScreenUpdating = False '禁用屏幕刷新
'计算全文字数
Selection.WholeStory
CharCount = Selection.Characters.Count
'将光标定位到文档开头并折叠选区，确保从第一个字符开始遍历
Selection.HomeKey Unit:=wdStory
Selection.Collapse Direction:=wdCollapseStart
'确保光标在文档开头且折叠
Selection.HomeKey Unit:=wdStory
Selection.Collapse Direction:=wdCollapseStart
'开始计时
Time1 = Timer
CnCount = 0
'每次选择的字符个数:
'纯中文: [1-8],建议值=[5-8], 太短速度慢,太长丢拼音
'中英文混排: [1], 速度慢但更安全,大于1会报错
Num = 1
'标注拼音
If Num = 1 Then
'选择文字:逐个选择中文字符并标注拼音--速度慢但更安全
For Loops = 1 To CharCount
CursorPos = Selection.MoveRight(Unit:=wdCharacter, Count:=1, Extend:=wdExtend)
SubLength = Len(Selection.Text)
LastChar = Right(Selection.Text, 1)
If LastChar Like "[一-龥]" Then
SendKeys "{enter}", True
Application.Run MacroName:="FormatPhoneticGuide" '标注拼音
CnCount = CnCount + 1
End If
Selection.MoveRight Unit:=wdCharacter, Count:=SubLength
Next
Else
'选择文字:选择字符串并标注拼音--速度快但有风险
Set DocRange = ActiveDocument.Content
FullText = DocRange.Text
'从头开始标注拼音
For I = 1 To CharCount Step Num
CursorPos = Selection.MoveRight(Unit:=wdCharacter, Count:=Num, Extend:=wdExtend)
SubLength = Len(Selection.Text)
Block = Mid(FullText, I, Num)
HasChinese = False
'检查当前字符串是否包含汉字
For J = 1 To Len(Block)
Ch = Mid(Block, J, 1)
'判断基本汉字区
If Ch Like "[一-龥]" Then
HasChinese = True
Exit For
End If
Next J
'如果字符串包含汉字，则在文档中选中该区域并添加拼音
If HasChinese Then
SendKeys "{enter}", True
Application.Run MacroName:="FormatPhoneticGuide" '标注拼音
CnCount = CnCount + 1
End If
Selection.MoveRight Unit:=wdCharacter, Count:=SubLength
Next I
End If
'结束计时
Time2 = Timer
If Time2 < Time1 Then
Time2 = Time2 + 24 * 3600
End If
'计算标注速度
Time0 = Time2 - Time1
If Time0 = 0 Then
Time0 = 1
End If
Speed = CnCount / Time0
'设置拼音格式:字体=等线/字号=8/对齐方式=居中
ActiveWindow.View.ShowFieldCodes = True '显示域代码:Alt+F9切换
Application.ScreenUpdating = False '禁用屏幕刷新
Selection.HomeKey Unit:=wdStory '移动光标到全文开头
'使用Range对象进行全文查找替换，避免依赖 Selection
Set Rng = ActiveDocument.Range
With Rng.Find
'清除之前的格式设置，并设置通用查找参数
.ClearFormatting
.Replacement.ClearFormatting
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchByte = True
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
'替换拼音字体
.Text = Hz_Font
.Replacement.Text = Py_Font
.Execute Replace:=wdReplaceAll
'替换拼音字号
.Text = Hz_hps0
.Replacement.Text = Py_Size
.Execute Replace:=wdReplaceAll
'替换拼音对齐方式
.Text = "jc2"
.Replacement.Text = Py_jc00
.Execute Replace:=wdReplaceAll
End With
'恢复原始环境设置
ActiveWindow.View.ShowFieldCodes = False '关闭域代码
Application.ScreenUpdating = True '恢复屏幕刷新
Selection.HomeKey Unit:=wdStory '移动光标到全文开头
MsgBox "拼音标注完毕, 请手工调整." & vbCrLf & "标注次数=" & CnCount & vbCrLf & "耗时秒数=" & Round(Time0, 3) & vbCrLf & "标注速度=" & Round(Speed, 3)
End Sub

复制代码

恭请高手帮忙优化Word自动标注拼音的VBS脚本

汉字标注拼音的方法:
1. 拼音字体    : 简单/可能收费+样式固定+繁体字可能缺失
2. 专业注音软件  : 简单/可能收费
3. Word拼音指南  : 通用+样式自定义/自动标注拼音必须用脚本

本文只讨论"3.Word拼音指南"的方式.

脚本说明:
Word自动标注拼音:格式-中文版式-拼音指南
Word格式:必须为纯文本格式:无格式文本/无格式的Unicode文本
标注原理:模拟运行Word内置宏"FormatPhoneticGuide"
注意事项:运行期间,拼音指南窗口频繁闪烁,请耐心等待脚本运行完毕,中途请勿切换窗口
汉字范围的扩展:
常用范围：\u4e00-\u9fa5（约2万多汉字）--[一-龥]
扩展范围：\u3400-\u4dbf（扩展A区）和 \u4e00-\u9fff（更完整的常用区）
大多数情况下，使用 \u4e00-\u9fa5 或 [一-龥] 就足够了

测试情况:
Windows 10 + Word 2003/2007/2013正常运行

目前问题:
1. 逐个汉字标注, 速度慢.
2. 模拟运行Word内置宏"FormatPhoneticGuide", 无法真正全自动标注.
3. 只能前台运行.

邪恶海盗 · 发表于昨天 19:23

想速度快就用带拼音的字体，另外我好奇目的是啥，毕竟存在多音字的问题...

二○二六年三月十一日

fengge2018 · 发表于昨天 20:17

坐等大侠出手。这是已经实现了？为啥要优化，往哪方面优化？

l987142018 · 发表于昨天 21:00

路过帮顶

a66 · 发表于昨天 23:31

了解

gordonhf · 发表于 11 小时前

路过帮顶

ztc999 · 发表于 5 小时前

谢谢分享

xwei9277 · 发表于 3 小时前

想快和实时，可以用vsto做个插件，没啥用啊

1e3e · 发表于 3 小时前

路过义务帮顶

ohte · 发表于 2 小时前

守柔拼音一次处理30个字

SendKeys "{enter}", True应该是False

		自动登录	找回密码
密码			注册

[讨论] 恭请高手帮忙优化Word自动标注拼音的VBS脚本