Private Declare Function GetKeyboardLayoutName _

                          Lib "user32" Alias "GetKeyboardLayoutNameA" _

                              (ByVal pwszKLID As String) As Long

Private Declare Function ActivateKeyboardLayout _

                          Lib "user32" (ByVal HKL As Long, _

                                        ByVal flags As Long) As Long

Sub ChangeKeyboardLayout()

    Dim KeybLayoutName As String, iState As Integer

    KeybLayoutName = String(9, 0)

    GetKeyboardLayoutName KeybLayoutName

    '409 - английская,

   '419 - русская

   'получение значения текущей раскладки

   iState = Val(CStr(CLng(Left$(KeybLayoutName, InStr(1, KeybLayoutName, Chr(0)) - 1))))

    Select Case iState

        Case 409

            MsgBox "Текущая раскладка Английская! Сменим на русскую!", 64, ""

        Case 419

            MsgBox "Текущая раскладка Русская! Сменим на английскую!", 64, ""

        Case Else

            MsgBox "Текущая раскладка какая-то другая! Менять не будем", 64, ""

    End Select

    'Переключение раскладки с русскую на английскую

   If iState = 419 Then

        ActivateKeyboardLayout 0, 0

    End If

    'Переключение раскладки с английской на русскую

   If iState = 409 Then

        ActivateKeyboardLayout 0, 0

    End If

End Sub