Oscar Sun

                  Sub BiHua() '指定筆畫後列出該筆畫可供取名之字 Alt+w
Dim rst As New ADODB.Recordset
Dim x As String ', bs As Byte
system.cntOpen
If Selection.Type = wdSelectionIP Then Exit Sub
x = Selection
Selection.Font.Name = "標楷體"
Selection.Font.Size = 16
Selection.ParagraphFormat.LineSpacingRule = wdLineSpaceExactly
Selection.ParagraphFormat.LineSpacing = 20

If Not IsNumeric(x) Then Exit Sub
If CByte(x) > 25 Or CByte(x) < 4 Then Exit Sub
system.cntOpen
rst.Open "select 字,命名筆畫驗算過,部首ID from 字 where 命名筆畫 = " & CInt(x) & " and 取名字=true order by 部首ID,字", cnt, adOpenKeyset, adLockReadOnly
With rst
    Selection.MoveRight wdCharacter, 4, wdMove
    Do Until .EOF
'        If bs <> VBA.CByte(.Fields("部首ID").Value) Then Selection.TypeText Chr(11)
'        bs = VBA.CByte(.Fields("部首ID").Value)
        If .Fields("命名筆畫驗算過").Value = -1 Then
            Selection.Font.ColorIndex = wdAuto
        Else
            Selection.Font.ColorIndex = wdRed
        End If
        Selection.TypeText .Fields("字").Value
        .MoveNext
    Loop
End With
rst.Close
cnt.Close
End Sub