Oscar Sun

                  Sub 聲符構字列出()
'Alt+8
Dim db As String, cnt As New ADODB.Connection, rst As New ADODB.Recordset, sf As String, rng As Range, flg As Boolean
db = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & dbFile("諧聲字檢索系統", "")
If Selection.Characters.Count > 1 Then Exit Sub
sf = Selection.Text
If Selection.Type = wdSelectionIP Then
    Selection.MoveRight
Else
    Selection.Collapse wdCollapseEnd
End If
cnt.Open db
rst.Open "SELECT DISTINCT 形聲字.形聲字, 聲符,序號 " & _
        "FROM 聲符 INNER JOIN 形聲字 ON 聲符.聲符ID = 形聲字.聲符ID " & _
        "WHERE (((StrComp(聲符,""" & sf & """))=0)and(instr(序號,""00"")=0)) " & _
        "ORDER BY 形聲字.形聲字;", cnt
Set rng = Selection.Range
Do Until rst.EOF
    rng.InsertAfter rst.Fields("形聲字").Value
    flg = True
    rst.MoveNext
Loop
If flg Then
    rng.Select
    CHINAWORD.只留下黃選3000常用字_未選取則以paragraph為單位
Else
    MsgBox "尚無此聲符！", vbExclamation
End If
rst.Close: cnt.Close: Set rst = Nothing: Set cnt = Nothing
End Sub