Private Declare Function GetKeyboardLayoutName Lib "user32" _
                            Alias "GetKeyboardLayoutNameA" _
                            (ByVal pwszKLID As String) As Long
            
Private Declare Function LoadKeyboardLayout Lib "user32" _
                            Alias "LoadKeyboardLayoutA" _
                            (ByVal pwszKLID As String, _
                            ByVal flags As Long) As Long

Public Const LANG_EN_US As String = "00000409"
Public Const LANG_RUS As String = "00000419"

Private Const KL_NAMELENGTH As Long =  9 &
Private Const KLF_ACTIVATE  As Long = &H1&

'Вызывать так:
'SetKbLayout LANG_RUS
'SetKbLayout LANG_EN_US
Public Function SetKbLayout(strLocaleId As String) As Boolean
On Error Resume Next
    Dim strLocId As String
    Dim strMsg As String
    Dim lngErrNr As Long

    strLocId = String(KL_NAMELENGTH,  0 )
    GetKeyboardLayoutName strLocId
    If strLocId = (strLocaleId & Chr( 0 )) Then
        SetKbLayout = True
    Else
        strLocId = String(KL_NAMELENGTH,  0 )
        strLocId = LoadKeyboardLayout((strLocaleId & vbNullChar), KLF_ACTIVATE)
        If IsNull(strLocId) Then
            SetKbLayout = False
        Else
            strLocId = String(KL_NAMELENGTH,  0 )
            GetKeyboardLayoutName strLocId
            If strLocId = (strLocaleId & Chr( 0 )) Then
              SetKbLayout = True
            Else
              SetKbLayout = False
            End If
        End If
    End If
End Function