VB Forum / Database Access / October 2008

Dear DesignStudio,

It's pretty easy once you've grasped the logic. The bulk of time wasted is
to namely understand the logic. The rest is simple.

Here is a little function I wrote, which can be called from any event in my
programme. It changes the keyboard layout to the desired one, provided it is
installed. If the desired layout has not been installed, the function
displays a message to the user.

I use this code in a MSAccess application. It utilises a table called
"Locales" that stores information about different locales and languages.
Below is and excerp from the table:

LCID       Locale                          Language        LCName  Tag    
CP_ANSI     acPLID

&H0402  Bulgarian (Bulgaria)       Bulgarian        bg-BG   Cyrl     1251    
   4
&H0407  German (Germany)        German          de-DE   Latn    1252        9
&H0409  English (United States)   English           en-US   Latn    1252    
  11

And here is the code:

Public Function Lang_Keyboard_Change(Optional ByVal sArg As String =
"&H0409", _
                                       Optional ByVal sArgType As String =
"LCID" _
                                       ) As Boolean
   
   'This function changes the keyboard language to the desired one.
   'It assumes that the system default language is English(Primary language
code = 0x09.
   'and that its hex code is passed by default.
   'If another locale argument's value is passed as an argument, then
   'the function looks up the LCID value in the Locales table.
   'If the language is installed, its layout is activated.
   'Else a message is displayed to the user and current language
   'layout is kept.
   
   Dim sA As String, sB As String, sC As String
   Dim lA As Long, lB As Long, lC As Long
   
   On Error GoTo Err_1
   
   If sArgType = "LCID" Then
       lB = Val(Replace(sArg, "0x", "&H"))
   Else
       sA = sArgType & "='" & sArg & "'"
       sB = Nz(DLookup("LCID", "Locales", sA))
       If sB = "" Then
           'Unsupported or wrong locale.
'            MsgBox SM(6571) & vbCr & sArgType & "='" & sArg & "'"
           MsgBox "Wrong or unsupported regional settings." & vbCr _
               & sArgType & "='" & sArg & "'"
           Exit Function
       End If
       sB = Replace(sB, "0x", "&H")
       lB = Val(sB)
   End If
   
   'Extract language code and save it to a variable.
   lB = lB And &HFFFF&
   
   'lB is the Target KB value.
   
   If lB = 0 Then
       'Target KB Language is the system language, so go to true exit.
       GoTo Exit_True
   End If
   
   'Get initial/current layout name.
   lA = GetKeyboardLayout(0)
   
   'Exit if GetKeyboardLayout function failed.
   If lA = 0 Then
       Exit Function
   End If

   'Extract language code and save it to a variable.
   lA = lA And &HFFFF&
   
   'lA is the Initial KB value.
   
   'Check if this is the desired language code.
   If lA = lB Then
       'Language is the same, so go to true exit.
       GoTo Exit_True
   End If
   
   'Activate the previous keyboard layout.
   lC = ActivateKeyboardLayout(HKL_PREV, KLF_ACTIVATE)
   'Get layout.
   lC = GetKeyboardLayout(0)
   'Extract language code.
   lC = lC And &HFFFF&
   
   'Loop through installed keyboard layouts
   'until the desired language is loaded or
   'loop completes a full cycle.
   Do
       If lC = lB Then
           'This is the needed language, so exit
                       'loop and go to true exit.
           GoTo Exit_True
       End If
       
       'Activate the previous keyboard layout.
       lC = ActivateKeyboardLayout(HKL_PREV, KLF_ACTIVATE)
       'Get layout.
       lC = GetKeyboardLayout(0)
       'Extract language code.
       lC = lC And &HFFFF&
   Loop While lC <> lA
   
   'The desired keyboard layout is not installed on the system.
   'Display a message to the user.
   If sArgType = "LCID" Then
       sA = sArgType & "='" & Replace(sArg, "0x", "&H") & "'"
   Else
       sA = sArgType & "='" & sArg & "'"
   End If
   sB = Nz(DLookup("Locale", "Locales", sA))
   MsgBox sB & vbCrLf & "The desired keyboard layout is not installed on
the system." _
           & "Install it first from Control Panel > " _
           & "Regional and Language Options.", vbInformation, sAppTitle
Exit_False:
   Exit Function
   
Exit_True:
   Lang_Keyboard_Change = True

Exit_1:
   Exit Function
   
Err_1:
   MsgBox Err.Description, vbExclamation, sAppTitle
   Resume Exit_1
   
End Function

I hope you find this post usefull. It works fine for me.
Good luck.
Best wishes from Bulgaria!