组合框使用教程(四)---数据快速选择或输入

一点通 · 发表于 2007-8-25 16:38:31

本教程列举四种方法，当然还会有其它方法的

一、双击选择数据（向下查找一个数据）
Private Sub 组合148_DblClick(Cancel As Integer)  '双击事件
  If 组合148.ListCount < 1 Then Exit Sub

  Dim I As Long
  I = 组合148.ListCount  '设定范围
  If 组合148.ListIndex < I - 1 Then
组合148.ListIndex = 组合148.ListIndex + 1  '向下移动取值
  Else
组合148.ListIndex = 0
  End If

End Sub

二、用小键盘输入数值快速显示数据
Private Sub 组合151_KeyUp(KeyCode As Integer, Shift As Integer)  '键释放事件
SelectValue Me.组合151, KeyCode  '调用下面的过程
End Sub
Function SelectValue(ByRef ComboOrList As Control, ByVal KeyCode As Integer)
Debug.Print KeyCode

With ComboOrList
      If KeyCode >= 96 And KeyCode <= 105 Then '设定键盘的输入范围，0键=96 --> 9键=105  也就是说本函数只能输入1~9的数值来提取
         If .ListCount >= KeyCode - 96 Then
         '如果列表的数量>= 10
            .Value = .Column(.BoundColumn - 1, KeyCode - 96 - 1)
         End If
      End If

End With
End Function

三、利用自定义代码显示数据
Private Sub 组合154_AfterUpdate() '更新后事件
If IsNull(DLookup("名称", "水质生产单位", "[名称]='" & 组合154 & "'")) Then  '当列表找不到对应数据时

If Not IsNull(DLookup("名称", "水质生产单位", "[代码]='" & 组合154 & "'")) Then  '查找表中的代码是否有对应的数据
      Me.组合154 = DLookup("名称", "水质生产单位", "[代码]='" & 组合154 & "'")  '当有对应数据时在组合框显示
Else
      MsgBox "找不到指定的数据, 请重新输入" '没有对应数据弹出提示
      Me.组合151.SetFocus
      Me.组合154.SetFocus
      Me.组合154 = ""
End If
End If
End Sub

四、用拼音的首字母输入显示数据
Public Function ComboBoxKeyPress(KeyAscii As Integer) As String
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

Private Sub 生产单位_KeyPress(KeyAscii As Integer)
‘调用
If ComboBoxKeyPress(KeyAscii) <> "" Then KeyAscii = 0
End Sub

例子