支持拼音首字母的组合框函数及实例
Public 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
原文:http://www.office-cn.net/BBS/dispbbs.asp?BoardID=2&ID=24443 |