Public Declare Function VkKeyScanEx Lib "user32" _
    Alias "VkKeyScanExA" _
    (ByVal ch As Byte, _
    ByVal dwhkl As Long) As Integer
Public Declare Function GetKeyboardLayoutList _
    Lib "user32" _
    (ByVal nBuff As Long, _
    lpList As Long) As Long
Public Declare Function SystemParametersInfo _
    Lib "user32" _
    Alias "SystemParametersInfoA" _
    (ByVal uAction As Long, _
    ByVal uParam As Long, _
    lpvParam As Any, _
    ByVal fuWinIni As Long) As Long
Public Declare Function GetKeyboardLayout _
    Lib "user32" _
    (ByVal dwThreadID As Long) As Long
Public Declare Function ToAsciiEx Lib "user32" _
    (ByVal uVirtKey As Long, _
    ByVal uScanCode As Long, _
    lpKeyState As Byte, _
    lpwTransKey As Byte, _
    ByVal uFlags As Long, _
    ByVal dwhkl As Long) As Long

Public Const SPI_GETDEFAULTINPUTLANG = &H59&

Public Function CharToKeyCode(ch As String, _
    Optional iLang As Integer = &H409) As Integer
Static nLayouts As Long, Layouts() As Long
    Dim i As Long, bChar As Byte, iKey As Integer
    Dim iLay As Long, DefLay As Long
 
    If Len(ch) <> 1& Then Exit Function
    bChar = Asc(ch)
    SystemParametersInfo SPI_GETDEFAULTINPUTLANG, _
        0&, DefLay, 0&
    If iLang = (DefLay And &HFFFF&) Then
    ' Specified language is on the default layout
        iKey = VkKeyScanEx(bChar, DefLay) And &HFF
        If iKey <> 255 Then
            CharToKeyCode = iKey
            Exit Function
        End If
    End If
    ' Initialize Layouts array
    If nLayouts = 0& Then
        nLayouts = GetKeyboardLayoutList(0&, ByVal 0&)
        ReDim Layouts(0& To nLayouts - 1&)
        GetKeyboardLayoutList nLayouts, Layouts(0&)
    End If
    ' Search for layout with specified language
    For i = 0& To nLayouts - 1&
        If iLang = (Layouts(i) And &HFFFF&) Then
            iKey = VkKeyScanEx(bChar, _
                Layouts(i)) And &HFF
            If iKey <> 255 Then
                CharToKeyCode = iKey
                Exit Function
            End If
        End If
    Next
    ' Not found - search char on default layout
    iKey = VkKeyScanEx(bChar, DefLay) And &HFF
    If (iKey <> 255) And (iKey <> 0) Then
        CharToKeyCode = iKey
        Exit Function
    End If
    ' Not found - search char on any layout
    For i = 0& To nLayouts - 1&
        iKey = VkKeyScanEx(bChar, Layouts(i)) And &HFF
        If (iKey <> 255) And (iKey <> 0) Then
            CharToKeyCode = iKey
            Exit Function
        End If
    Next
End Function

Public Function KeyCodeToChar( _
            ByVal KeyCode As Integer) As String
    Dim s As String, b(0 To 255) As Byte
    Dim ss(0 To 1) As Byte, i As Long
    i = ToAsciiEx(KeyCode, 0&, b(0), _
        ss(0), 0&, GetKeyboardLayout(0&))
    KeyCodeToChar = UCase$(Left$(StrConv(ss, _
        vbUnicode), i))
End Function