作者：绿色风
分类：
时间：2022-08-18
浏览：288
楼主
篮板球 |
可以尝试通过Excel对照查找文字找添加拼音的代码，不用考虑定义文件夹目录。
共享地址如下：https://skydrive.live.com/redir.aspx?cid=1ea35c8098b0c128&resid=1EA35C8098B0C128!140&parid=1EA35C8098B0C128!139
注：
确认只打开Excel字典文件;
可以将代码添加到Normal.dotm;
请在VB编辑器的工具菜单/ 引用中勾选Microsoft Excel 14.0 object library, 查看下图：
代码如下：
- '请将此代码粘贴于全局模板中.
- Sub GetPinYin()
- Dim xlObj As Excel.Application, xlWb As Excel.Workbook, Hz As Range, HzRange As Excel.Range, c As Excel.Range, PY As String
- Dim WordDoc As Document, Range1 As Range, AtdName As String, DefPath As String
- On Error GoTo ErrHandle
- Application.ScreenUpdating = False
- AtdName = ActiveDocument.Name '取得活动本档名
- DefPath = ActiveDocument.Path '取得默认WORD文件夹位置
- Set WordDoc = Documents.Add '设置新文档
- Documents(AtdName).Activate '返回活动文档
- If Tasks.Exists("Microsoft Excel") = True Then '检查并建立EXCEL程序
- Set xlObj = GetObject(, "Excel.Application")
- Else
- Set xlObj = CreateObject("Excel.Application")
- End If
- Set xlWb = xlObj.Workbooks.Open(DefPath & "\ExPinYin.xls") '打开该简体拼音工作薄
- Set Myrange = xlWb.Sheets(1).Range("a1:a6763") '设置区域
- For Each Hz In ActiveDocument.Characters '在活动文档中遍历每个字
- With Myrange
- Set c = Myrange.Find(Hz, LookIn:=xlValues)
- If Not c Is Nothing Then
- PY = c.Offset(, 1) '取得工作薄中的拼音
- Hz.PhoneticGuide Text:=PY, FontSize:=10 '加注拼音指南,注意此时已变成域
- ActiveDocument.Fields(1).Cut '剪切域
- Else
- Hz.Cut '剪切没有找到的文字
- End If
- End With
- With WordDoc
- Set Range1 = .Content '在新文档的最后粘贴剪贴板上的内容
- Range1.Collapse Direction:=wdCollapseEnd
- Range1.Paste
- End With
- Next
- xlObj.Quit '关闭EXCEL程序
- WordDoc.Activate
- WordDoc.SaveAs FileName:="PinYin" & AtdName '保存新文档
- MsgBox "自动拼音加注已完成!"
- Application.ScreenUpdating = True
- Exit Sub
- ErrHandle:
- MsgBox "请检查各文件位置或者活动文档的文本内容是否超过了32000个汉字"
- End Sub
|
2楼
海洋之星 |
- Sub 批量加注拼音()
- On Error Resume Next
- ingend = ActiveDocument.Content.End
- For i = ingend To 0 Step -30
- If i - 30 <= 0 Then
- ActiveDocument.Range(0, i).Select
- Else
- ActiveDocument.Range(i - 30).Select
- End If
- SendKeys "{enter}", False
- Application.Run "formatphoneticguide"
- Next
- End Sub
|
免责声明
有感于原ExcelTip.Net留存知识的价值及部分知识具有的时间限定性因素，
经与ExcelTip.Net站长Apolloh商议并征得其同意，
现将原属ExcelTip.Net的知识帖采集资料于本站点进行展示，
供有需要的人士查询使用，也慰缅曾经的论坛时代。
所示各个帖子的原作者如对版权有异议，
可与本人沟通提出，或于本站点留言，我们会尽快处理。
在此，感谢ExcelTip.Net站长Apolloh的支持，感谢本站点所有人**绿色风（QQ:79664738)**的支持与奉献，特此鸣谢！
------本人网名**KevinChengCW（QQ:1210618015)**原ExcelTip.Net总版主之一