DATACOMBO

USUARIO.EXCLUIDOS 23/06/2004 10:50:03
#30831
Gostaria de saber como pesquisa em um datacombo a medida q eu digito um valor nele.

estou usando o seguinte código

'''''''''''''''''''''''''''''''''''''''''''
Sub DadosCombo(Dcbo As DataCombo, RS As adodb.Recordset, KeyAscii As Integer)
'Dim sBuffler As String
Dim IRetVal As Long
If KeyAscii = 34 Or KeyAscii = 39 Or KeyAscii = 96 Or KeyAscii = 126 Or KeyAscii = 13 Then
KeyAscii = 0
Exit Sub
End If
sBuffler = Left(Dcbo.Text, Dcbo.SelStart) & Chr(KeyAscii)
Dim RS_int As adodb.Recordset, criterio As String
Set RS_int = RS
criterio = "" & Dcbo.BoundColumn & ""
criterio = criterio
criterio = criterio & " like '" & sBuffler & "%'"
RS_int.MoveFirst
RS_int.Find criterio
If RS_int.EOF = False Then
Dcbo.Text = RS_int(Dcbo.BoundColumn)
Dcbo.SelStart = Len(sBuffler)
Dcbo.SelLength = Len(Dcbo.Text)
End If
KeyAscii = 0
Set RS_int = Nothing
End Sub
'''''''''''''''''''''''''''''''''''''''''''''''''''
e no evento keypress eu chamo a essa função, mais só me deixa digitar um unico caracter.

Sem Mais
USUARIO.EXCLUIDOS 23/06/2004 10:57:07
#30836 Resposta escolhida
Vá no link abaixo

http://www.macoratti.net/dica22.htm

ou Mude para

Sub DadosCombo(Dcbo As DataCombo, RS As adodb.Recordset, KeyAscii As Integer)
'Dim sBuffler As String
Dim IRetVal As Long
If KeyAscii = 34 Or KeyAscii = 39 Or KeyAscii = 96 Or KeyAscii = 126 Or KeyAscii = 13 Then
KeyAscii = 0
Exit Sub
End If
sBuffler = Left(Dcbo.Text, Dcbo.SelStart) & Chr(KeyAscii)
Dim RS_int As adodb.Recordset, criterio As String
Set RS_int = RS
criterio = "" & Dcbo.BoundColumn & ""
criterio = criterio
criterio = criterio & " like '" & sBuffler & "%'"
RS_int.MoveFirst
RS_int.Find criterio
If RS_int.EOF = False Then
Dcbo.Text = RS_int(Dcbo.BoundColumn)
Dcbo.SelStart = Len(Dcbo.text)
Dcbo.SelLength = Len(Dcbo.Text)
End If
KeyAscii = 0
Set RS_int = Nothing
End Sub

Se quiser tenho uma clas
USUARIO.EXCLUIDOS 23/06/2004 11:21:19
#30851
Já te enviei
USUARIO.EXCLUIDOS 23/06/2004 11:49:31
#30863
é para um data combo não tenho exemplo.

Mas o combo comum aceita acoplagem ADO

Set combo.datasource = RSADO

Pelo menos é assim que uso
USUARIO.EXCLUIDOS 23/06/2004 12:00:23
#30868
Tente fazer isto com o ComboBox para ele preecher sozinho

Set Combo.Datasource = RecordsetAdo
USUARIO.EXCLUIDOS 23/06/2004 12:23:42
#30873
Tente

cnn.Open "Provider=Microsoft.Jet.OLEDB.3.51;Persist Security Info=False;Data Source=" & Path_Db & "Db_ger_rel.mdb;"

RS_Ape_Alm.Open "Select APELIDO from Tag_cad order by APELIDO", cnn, adOpenStatic, _
adLockOptimistic
Set Combo1.DataSource = RS_Ape_Alm
USUARIO.EXCLUIDOS 23/06/2004 12:45:25
#30876
Desculpe mas tem que usar o ADODataControl

Vá neste link


http://www.macoratti.net/ado_dc.htm
USUARIO.EXCLUIDOS 23/06/2004 13:51:15
#30887
Quando chegar em casa farei um exemplo e te envio por email até amahã, Tá legal?
USUARIO.EXCLUIDOS 24/06/2004 10:57:07
#31029
Te enviei um exemplo, mas mesmo assim vou postar o código

Para usar com DAO e ADO

Dim c as new clscombo
set c.controle = combo1
c.AcoplarCombo(recordset, Campo)


Para exibir a lista

c.mostrarlista


Para localizar um item

msgbox c.Acharitem(Palavra)


Classe CLSCombo

'---------------------------------------------------------------------------------------
' Module    : CLSCombo
' DateTime  : 23/06/2004 16:52
' Author    : Flavio Paganini
' Purpose   : Provem recursos de acoplagem (ADO - DAO) e auto completar em combo comum
'---------------------------------------------------------------------------------------
Option Explicit

Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long

Private Const CB_ERRO = (-1)
Private Const CB_ACHARSTRING = &H14C
Private Const CB_ACHARSTRINGEXATA = &H158
Private Const CB_MOSTRARLISTA = &H14F

Public WithEvents Controle As ComboBox
Public Function AcharItem(Palavra As String, Optional IndiceInicio As Long = -1, Optional Exato As Boolean = False) As Long
    'Localize um item da combo sem percorre - la
    'Apenas passe a string que a função retorna o sua posição
    
    Dim Msg As Long
    Msg = IIf(Exato, CB_ACHARSTRINGEXATA, CB_ACHARSTRING)
    Palavra = Palavra & Chr(0)
    AcharItem = SendMessage(Controle.hwnd, Msg, IndiceInicio, ByVal Palavra)
End Function
Public Sub AcoplarCombo(OBDataSource As Object, OBDataField As String)
    'Popule a lista de um combo comum com ADo ou DAO
    'Apenas passe o recordset no objeto OBDataSource
    'e o campo em OBDataField
    
    Dim s As String
    Dim rs As Object
    Set rs = OBDataSource
    Controle.Clear
    rs.MoveFirst
    Do
        If rs.EOF Then Exit Do
        Controle.AddItem rs.Fields(OBDataField).Value
        rs.MoveNext
    Loop
End Sub
Public Sub MostrarLista()
SendMessage Controle.hwnd, CB_MOSTRARLISTA, True, 0
End Sub
Public Sub OcultarLista()
    SendMessage Controle.hwnd, CB_MOSTRARLISTA, False, 0
End Sub
Private Sub Controle_KeyUp(KeyCode As Integer, Shift As Integer)
    Dim iLocal As Integer, sTexto As String
    Dim iSelStart As Integer, iSelLength As Integer
    With Controle
        If KeyCode <> vbKeyBack And KeyCode > 48 Then
            sTexto = .Text
            iLocal = AcharItem(sTexto, , False)
            If iLocal <> -1 Then
                MostrarLista
                .Text = .List(iLocal)
                .SelStart = Len(sTexto) - 1
                .SelLength = Len(.Text) - .SelStart
            Else
                
                iSelStart = .SelStart
                iSelLength = .SelLength
                OcultarLista
                .Text = sTexto
                .SelStart = iSelStart
                .SelLength = iSelLength
            End If
        End If
    End With
End Sub
Tópico encerrado , respostas não são mais permitidas
Voltar