Lançar na Combo

Private Sub combo1_KeyPress(KeyAscii As Integer)

   KeyAscii = Combo_AutoCompletar(combo1, KeyAscii)

End Sub

Lançar o Código abaixo em General Declarations:

Option Explicit

Private Const CB_FINDSTRING As Long = &H14C

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

Public Function Combo_AutoCompletar(xCombo As ComboBox, ByVal xKeyAscii As Long, Optional ByVal xUpperCase As Boolean = True) As Long

    Dim lngFind As Long, intPos As Long, intLength As Long, tStr As String

    With xCombo

        If xKeyAscii = 8 Then

            If .SelStart = 0 Then Exit Function

            .SelStart = .SelStart - 1

            .SelLength = Len(.Text)

            .SelText = vbNullString

        Else

            intPos = .SelStart

            tStr = .Text

            .SelText = (Chr$(xKeyAscii))

'            .SelText = IIf(xUpperCase, _

'                           UCase$(Chr$(xKeyAscii)), _

'                           LCase$(Chr$(xKeyAscii)))

        End If

        lngFind = SendMessage(.hwnd, CB_FINDSTRING, 0, ByVal .Text)

        If lngFind = -1 Then

            .Text = tStr

            .SelStart = intPos

            .SelLength = (Len(.Text) - intPos)

            Combo_AutoCompletar = xKeyAscii

        Else

            intPos = .SelStart

            intLength = Len(.List(lngFind)) - Len(.Text)

            .SelText = .SelText & Right$(.List(lngFind), intLength)

            .SelStart = intPos

            .SelLength = intLength

        End If

    End With

End Function