汉字上方注拼音或汉字右侧注拼音

chuhaiou

Sub 汉字上方注拼音()'word2000
With Selection
    If .End - .Start = 0 Then MsgBox "请先选择要注音的字符，你可能还没有选择任何字符。": Exit Sub
    x = .Characters.Count
    .MoveLeft
    For I = 1 To x
    t = Selection
        s = Int(.Font.Size)
        s2 = .Font.Name
        On Error Resume Next
        v = ActiveDocument.Variables(t).Value
        If Err Then
            .MoveRight
            Err = 0
        Else
            .Fields.Add .Range, wdFieldEmpty, "EQ \* jc2 \* ""Font:" & t2 & """ \* hps" & 2 * s & " \o\ad(\s\up 12(" & v & ")," & t & ")", False
            ActiveDocument.Fields(ActiveDocument.Fields.Count).ShowCodes = False
            .Delete
        End If
    Next I
End With
End Sub
Sub 汉字右侧注拼音()
With Selection
    If .End - .Start = 0 Then MsgBox "请先选择要注音的字符，你可能还没有选择任何字符。": Exit Sub
    x = .Characters.Count
    .MoveLeft
    For I = 1 To x
    t = Selection
        On Error Resume Next
        v = ActiveDocument.Variables(t).Value
        If Err Then
            .MoveRight
            Err = 0
        Else
            .TypeText t & "(" & v & ")"
            .Delete
        End If
    Next I
End With
End Sub

[ 本帖最后由 chuhaiou 于 2010-6-29 21:43 编辑 ]

chinablank

好像用不了！

kqbt

测试了一下，前后似乎没有任何变化？！

chuhaiou

我就上传拼音模板吧。你试试行不！

youliqi

不能用啊……

chuhaiou

我上传拼音模板能用呀，你取用宏了吗？

守柔

原帖由 chuhaiou 于 2010-6-29 00:43 发表
Sub 汉字上方注拼音()'word2000
With Selection
    If .End - .Start = 0 Then MsgBox "请先选择要注音的字符，你可能还没有选择任何字符。": Exit Sub
    x = .Characters.Count
    .MoveLeft
    For I =  ...

楼主有兴趣不妨测试一下这几个程序：
http://club.excelhome.net/viewthread.php?tid=369617
http://club.excelhome.net/thread-402885-1-1.html
http://club.excelhome.net/viewthread.php?tid=72844

weiyingde

经测试，没有反应，请楼主解释一下。