[分享]WORD中的拼音加注程序

fieldsun

在守柔的启发下,我换了一下思路,对文章从后向前加拼音,在2000下通过(需要引用MS EXCEL 9.0 OBJECT LIBRARY)

Sub Addpinyin() Dim hz As Range, charcount, i charcount = ActiveDocument.Characters.Count On Error Resume Next For i = charcount To 1 Step -1 Set hz = ActiveDocument.Range(i, i + 1) If Not hz Is Nothing Then If hz <> "" And hz > "z" Then 'z合适吗? hz.Select SendKeys "{enter}", False Application.Run MacroName:="FormatPhoneticGuide" DoEvents End If End If Next i On Error GoTo 0 End Sub

fieldsun

不错,好好学习一下

感谢守柔!

在2000一试用了下,发现还有一点问题,抽空再做祥细测试

[此贴子已经被作者于2004-7-21 8:46:19编辑过]

fieldsun

我一直有个心愿,是直接调用微软拼音给WORD文档加拼音,用以下代码直接调用格式中拼音指南,仍不如意,拼音的对齐,字体\字号等不知道如何加,执行中也有问题,请守柔版主看看如何改进(OFFICE2000以上+微软拼音3.0)

Sub Addpinyin() Dim hz As Range On Error Resume Next For Each hz In ActiveDocument.Characters hz.Select SendKeys "{enter}{enter}", False Application.Run MacroName:="FormatPhoneticGuide" Next hz End Sub

[此贴子已经被作者于2004-7-17 14:39:18编辑过]

fieldsun

好,就是音调的标志是MSPY2.0的办法,要是用3.0的办法就更好了

lcgwdybg

很实用，谢谢

cslandzq

看不见程序呀

雪里飞花

一点都不好，打开是要密码的，密码又不告诉我们，缺德

banjinjiu

强烈建议使用菜单中的工具—宏—宏—运行Addpinyin，或者使用Alt+F8键运行该程序Addpinyin，因为有时程序会被发送的“回车”破坏。

1. Sub GetPYin() '拼音加注
   
2. Dim i As Range, FieldCount1 As Integer, FieldCount2 As Integer, ConEnd As Long, IpNumber As String
   
3. Dim StartRange As Long
   
4. On Error Resume Next
   
5. Application.ScreenUpdating = False
   
6. Selection.WholeStory
   
7. IpNumber = InputBox("您必须为拼音指定统一字号，请在此输入（5~20）", "汉字自动加注拼音")
   
8. If IpNumber = "" Then
   
9. Exit Sub
   
10. Else
    
11. Selection.Font.Size = CByte(IpNumber) * 2
    
12. End If
    
13. For Each i In ActiveDocument.Characters
    
14. If ActiveDocument.Fields.Count = 0 Then
    
15. StartRange = 0
    
16. Else
    
17. FieldCount1 = ActiveDocument.Fields.Count
    
18. ActiveDocument.Fields(FieldCount1).Select
    
19. Selection.Move
    
20. StartRange = Selection.Start
    
21. End If
    
22. ConEnd = StartRange + 30
    
23. If ConEnd > ActiveDocument.Content.End Then ConEnd = ActiveDocument.Content.End
    
24. ActiveDocument.Range(StartRange, ConEnd).Select
    
25. SendKeys "{enter}", False
    
26. Application.Run "FormatPhoneticGuide"
    
27. FieldCount2 = ActiveDocument.Fields.Count
    
28. If FieldCount1 = FieldCount2 Then Exit For
    
29. Next
    
30. Selection.WholeStory
    
31. Selection.Font.Size = CByte(IpNumber) * 1.5
    
32. ActiveDocument.Range(0, 0).Select
    
33. Application.ScreenUpdating = True
    
34. End Sub

复制代码

谢谢两位大侠。

weiyingde

banjinjiu 发表于 2014-10-6 00:43
强烈建议使用菜单中的工具—宏—宏—运行Addpinyin，或者使用Alt+F8键运行该程序Addpinyin，因为有时程序会 ...

谢谢你的代码，好用，但是拼音字体太小，几乎看不见，也不好调大小。若能演示一下，感激不尽。
先谢了

weiyingde

banjinjiu 发表于 2014-10-6 00:43
强烈建议使用菜单中的工具—宏—宏—运行Addpinyin，或者使用Alt+F8键运行该程序Addpinyin，因为有时程序会 ...

能否单独设置拼音的字体？