Private Declare Function GetKeyboardLayoutName Lib "user32" Alias "GetKeyboardLayoutNameA" (ByVal pwszKLID As String) As Long 

Private Const LANG_BULGARIAN = &H2 
Private Const LANG_CHINESE = &H4 
Private Const LANG_CROATIAN = &H1A 
Private Const LANG_CZECH = &H5 
Private Const LANG_DUTCH = &H13 
Private Const LANG_DANISH = &H6 
Private Const LANG_ENGLISH = &H9 
Private Const LANG_FINNISH = &HB 
Private Const LANG_FRENCH = &HC 
Private Const LANG_GERMAN = &H7 
Private Const LANG_GREEK = &H8 
Private Const LANG_HUNGARIAN = &HE 
Private Const LANG_ICELANDIC = &HF 
Private Const LANG_ITALIAN = &H10 
Private Const LANG_JAPANESE = &H11 
Private Const LANG_KOREAN = &H12 
Private Const LANG_NEUTRAL = &H0 
Private Const LANG_NORWEGIAN = &H14 
Private Const LANG_POLISH = &H15 
Private Const LANG_PORTUGUESE = &H16 
Private Const LANG_ROMANIAN = &H18 
Private Const LANG_RUSSIAN = &H19 
Private Const LANG_SLOVAK = &H1B 
Private Const LANG_SLOVENIAN = &H24 
Private Const LANG_SPANISH = &HA 
Private Const LANG_SWEDISH = &H1D 
Private Const LANG_TURKISH = &H1F 

Private Sub Command1_Click() 
 Dim KeybLayoutName As String 
 KeybLayoutName = String(8, "0") 
 GetKeyboardLayoutName KeybLayoutName 
 KeybLayoutName = CLng(KeybLayoutName) - 400 
 Select Case CLng(KeybLayoutName) 
 Case LANG_DUTCH, LANG_GERMAN 
  MsgBox "Немецкий язык" 
 Case LANG_ENGLISH 
  MsgBox "Английский язык" 
 Case LANG_RUSSIAN 
  MsgBox "Русский язык" 
 Case Else 
  MsgBox "Язык не определен" 
 End Select 
End Sub