支持拼音首字母的组合框函数及实例

Trynew

ublic Function ComboBoxKeyPress(KeyAscii As Integer) As String

'调用方法  在组合框的keypress方法中加入:

'--------------------------------------------

'    If ComboBoxKeyPress(KeyAscii) <> "" Then KeyAscii = 0

'--------------------------------------------

On Error GoTo Err

Dim i As Integer

With Screen.ActiveControl

    If .ControlType = acComboBox And (KeyAscii >= Asc("a") And KeyAscii <= Asc("z")) Then

    '只能由组合框输入小写字母时调用

        ComboBoxKeyPress = Nz(HZPY(Left(.Text, .SelStart))) & Chr(KeyAscii)

        While HZPY(Left(.ItemData(i), .SelStart + 1)) <> ComboBoxKeyPress And i < .ListCount - 1

            i = i + 1

        Wend

        If i <> .ListCount And Mid(.ItemData(i), .SelStart + 1, 1) <> Chr(KeyAscii) Then

            ComboBoxKeyPress = Left(.ItemData(i), .SelStart + 1)

            .Value = Null

            SendKeys ComboBoxKeyPress

        Else

            ComboBoxKeyPress = ""      '为英文时不代换，否则会进入死循环

        End If

    End If

End With

Exit Function

Err:

    ComboBoxKeyPress = ""

End Function

Function HZPY(hzstr As String) As String

Dim p0 As String, C As String, str As String

Dim i As Integer, j As Integer

p0 = "吖八嚓咑妸发旮铪讥讥咔垃呣拿讴趴七呥仨他哇哇哇夕丫匝咗"

For i = 1 To Len(hzstr)

    C = "z"

    str = Mid(hzstr, i, 1)

    If Asc(str) > 0 Then

        C = str

    Else

        For j = 1 To 26

            If Mid(p0, j, 1) > str Then

                C = Chr(95 + j)

                Exit For

            End If

        Next

    End If

    HZPY = HZPY + C

Next

End Function

下面是一个范例：

游客，如果您要查看本帖隐藏内容请回复

wu8313

感谢。经典之作。

tmtony

只有一句：出手必是精品：)

kaven

我用的时候总是出现 缺少 “end sub ” 我加上都没有用啊[em06][em06]

wusihan

确实经典

sea.er

以下是引用tmtony在2005-1-20 18:18:54的发言：

只有一句：出手必是精品：)

kaven

呵呵 请问老兄 我把上述代码直接加到Private Sub 申请人员id_KeyDown(KeyCode As Integer, Shift As Integer)（代码）End Sub但是 添加后 end sub 就自动消失 然后运行的时候提示缺少“end sub”我加上都没有用 请问是什么原因啊？[em04][em04][em04]

kaven

能不能指教一下啊 斑竹大人～～～[em06][em06][em06]

guotianxin

值得收藏

xinbao

不錯不錯