FUNCAO P/ VBA

IRENKO 20/11/2006 14:38:06
#185397

Peguei esse exemplo no forum ,alguem saberia como adaptar essa função para VBA?

'OBJETIVO
'Demonstrar como utilizar ComboBox com a propriedade Style = 2 (Dropdow List)
'permitindo que o usuário localize itens digitando uma string rapidamente com
'o foco neste controle

Option Explicit

'API utilizada para otimizar o desempenho
Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long

Public Const CB_ERR = -1 'ParÃ Â¢metro da API
Public Const CB_FINDSTRING = &H14C 'ParÃ Â¢metro da API

Public Const CLR_TIME As Double = 0.3 'Tempo entre digitos antes de limpar MEMO_STR

Dim LAST_TYPE As Double 'Tempo do Ãºltimo dÃgito
Dim MEMO_STR As String 'String válida na consulta

'Declarei combo como uma Combobox, mas poderia ser uma Listbos

Public Function ConsultaCombo(Combo As ComboBox, AsciiChar As Integer) As Integer
Dim s   As String
Dim l   As Long

    'Esc char Não precisa executar nada alÃ©m disto
    If AsciiChar = 27 Then
        MEMO_STR = ""
        LAST_TYPE = Timer
        Exit Function
        
    End If

    'Caso não encontre um item válido esta variável garante que se _
    mantenha o anteriormente selecionado
    s = MEMO_STR
    
    'Testa o tempo entre a digitação e escolhe qual string passar para API
    If Timer - LAST_TYPE > CLR_TIME Then
        MEMO_STR = Chr(AsciiChar)
        
    Else
        MEMO_STR = MEMO_STR & Chr(AsciiChar)
        
    End If

    With Combo

        'Deixemos a MS fazer o seu trabalho ....
        l = SendMessage((.hWnd), CB_FINDSTRING, -1, ByVal MEMO_STR)
        
        'Testamos o retorno e simplesmente aplicamos na propriedade ListIndex
        'Em caso de erro (-1) Beep e retorna o valor antigo a nossa MEMO_STR
        If l <> CB_ERR Then
            .ListIndex = l
        
        Else
            Beep
            MEMO_STR = s
        
        End If

    End With
    
    'Guardar o momento deste digito
    LAST_TYPE = Timer

End Function

'O retorno da função sempre será 0, _
como devemos sempre cancelar o keyascii escreve-se desta _
forma numa linha só as 2 tarefas

Private Sub Combo1X_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
KeyAscii = ConsultaCombo(ActiveControl, KeyAscii)==> dá erro aqui!!
End Sub

USUARIO.EXCLUIDOS 13/12/2006 01:57:46
#189610

huahuauha, fui eu quem enviei ...
vou ver o que faço !!!

CLEVERTON 13/12/2006 02:01:14
#189613

Veja este Exemplo AUTOCOMPLETAR COMBO SEM API

Página única

Tópico encerrado , respostas não são mais permitidas

Voltar