查找音韵地位的宏

据说记每个字的音韵地位是音韵学和方言调查的基础之一，但是现在这个浮躁的年代，还能真正花时间去记音韵地位的人太少了，对于我这样的懒人来说，这基本算是一个不可完成的任务。所以只能借助电脑了，之前老师那里有一份苏大张教授的查找音韵地位的宏，大家都用那个。最近一次方言课又需要用到这个东西，感觉之前那个稍有不便，所以自己写了一个，这里贴出代码给需要的同学。

1. 数据结构

数据库采用的是尉迟老师之前方言课里面让师兄师姐们数字化的方言调查字表，去年暑假我又写程序从word文本中抽取出了字头和音韵地位，数据结构很简单，如下：

zitou	yydw
多	果開一平歌端
拖	果開一平歌透
他	果開一平歌透

2. 使用方法

宏仅适用于Microsoft Word，数据库路径及字段名称可自由修改。由于使用了ADO，需在VBE中引用“Microsoft ActiveX Data Objects 2.5”组件（VBE编辑器中菜单“工具——引用”找到并勾选以上组件即可）。添加宏后，指定快捷键，选中需要查找音韵地位的汉字，按快捷键即可自动查找并用inputbox弹出查找结果：

3. vba代码

Sub 提取音韵地位()
'选中汉字，运行宏即可
    Dim zi, a As String
    Dim jg As String
    zi = Selection.Text

    Dim cnn As ADODB.Connection
    Dim rs As ADODB.Recordset
    Dim mydata As String, mySQL As String
    mydata = "C:\Program Files\音韵地位\yydw.mdb"
    Set cnn = New ADODB.Connection

    With cnn
        .Provider = "microsoft.jet.oledb.4.0"
        .Open mydata
    End With
    Set rs = New ADODB.Recordset
    mySQL = "select * from dw where zitou =" & "'" & zi & "'"
    rs.Open mySQL, cnn, adOpenKeyset, adLockOptimistic
    If rs.RecordCount <> 0 Then
        For icols = 0 To rs.RecordCount - 1
           a = rs.Fields("yydw")
           jg = jg & zi & " " & a & "   " & Chr(13)
        Next icols
        m = InputBox("共找到" & icols & "个结果。", "音韵地位", jg)
    Else
        MsgBox ("未找到“" & zi & "”" & "的音韵地位！")
    End If

    rs.Close
    cnn.Close
    Set rs = Nothing
    Set cnn = Nothing
End Sub