set focus cursor into two textboxes based on two language on PC

[Hasson]

hello

I search for way automatically without using manually from KEYBOARD . so I have textbox1, textbox2 on userform , and the languages on PC are ARABIC & ENGLISH .

from first time when put the cursor whether textbox1 or 2 should be english and if I click into textbox 1 or 2 then should change to ARABIC and every time click should automatically change to the other language .
note : when change the language should just be for textbox which I use for it , not all of together


thanks

 

[Jaafar Tribak]

A couple of questions:
1- What is your Windows version ?
2- What is your system default language ?
3- My understanding is that you want to alternate English and Arabic everytime you click on th TextBoxes . Is that correct ?

 

[Hasson]

1- What is your Windows version ?

Windows 10 64 bit

2- What is your system default language ?

I supposes arabic because when run PC it always shows arabic in the beginning

3- My understanding is that you want to alternate English and Arabic everytime you click on th TextBoxes . Is that correct ?

yes

 

[Jaafar Tribak]

Hi Hasson, I am sorry for not getting back to you sooner... I was busy.

Ok- Instead of using the textboxes click event for alternating the Arabic and English keyboards, please, use their DblClick event . This is in order to avoid interfering with the Enter and Exit events which are also used.


Place this in the UserForm Module:

Option Explicit

Private Enum LangEnum
    [_Default]
    Arabic
    English
End Enum

Private Type LangIds
    ArabicID As Long
    EnglishID As Long
End Type

Private tLangIds As LangIds

#If VBA7 Then
    Private Declare PtrSafe Function ActivateKeyboardLayout Lib "user32" (ByVal HKL As LongPtr, ByVal flags As Long) As LongPtr
    Private Declare PtrSafe Function GetKeyboardLayout Lib "user32" (ByVal dwLayout As Long) As LongPtr
    Private Declare PtrSafe Function GetKeyboardLayoutList Lib "User32.dll" (ByVal nBuff As Long, ByRef lpList As LongPtr) As Long
#Else
    Private Declare Function ActivateKeyboardLayout Lib "user32" (ByVal HKL As Long, ByVal flags As Long) As Long
    Private Declare Function GetKeyboardLayout Lib "user32" (ByVal dwLayout As Long) As Long
    Private Declare Function GetKeyboardLayoutList Lib "User32.dll" (ByVal nBuff As Long, ByRef lpList As Long) As Long
#End If

Private initKbLayout As Long  
  

Private Sub UserForm_Initialize()
    Call RetrieveKeyBoards
End Sub

Private Sub UserForm_Terminate()
    Call RestoreDefaultKeyBoard
End Sub


'////////////////////////////// TextBox1 \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
Private Sub TextBox1_Enter()
    Call ChangeLanguage(English)
End Sub
Private Sub TextBox1_Exit(ByVal Cancel As MSForms.ReturnBoolean)
    Call ChangeLanguage([_Default])
End Sub

Private Sub TextBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
    Call AlternateLangs
End Sub

'////////////////////////////// TextBox2 \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
Private Sub TextBox2_Enter()
    Call ChangeLanguage(English)
End Sub
Private Sub TextBox2_Exit(ByVal Cancel As MSForms.ReturnBoolean)
    Call ChangeLanguage([_Default])
End Sub

Private Sub TextBox2_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
    Call AlternateLangs
End Sub


'//////////////////////////////////////// HELPER ROUTINES //////////////////////////////////////////
Private Sub RetrieveKeyBoards()
    Dim arArabicIDs As Variant, arEnglishIDs As Variant, arKBLayouts As Variant
    Dim lNumLayouts As Long, i As Long
  
    arArabicIDs = Array(1025, 2049, 3073, 4097, 5121, 6145, 7169, 8193, 9217, 10241, 11265, 12289, 13313, 14337, 15361, 16385)
    arEnglishIDs = Array(1033, 2057, 3081, 4105, 5129, 6153, 7177, 8201, 9225, 10249, 11273, 12297, 13321)
  
    initKbLayout = LOWORD(CLng(GetKeyboardLayout(0)))
    lNumLayouts = GetKeyboardLayoutList(0, ByVal 0&)
    arKBLayouts = GetKeyboardLayouts
  
    With tLangIds
        For i = 0 To lNumLayouts - 1
            If .ArabicID And .EnglishID Then Exit For
            Select Case True
                Case Not IsError(Application.Match(LOWORD(CLng(arKBLayouts(i))), arArabicIDs, 0))
                    .ArabicID = LOWORD(CLng(arKBLayouts(i)))
                Case Not IsError(Application.Match(LOWORD(CLng(arKBLayouts(i))), arEnglishIDs, 0))
                    .EnglishID = LOWORD(CLng(arKBLayouts(i)))
            End Select
        Next
        If .ArabicID = 0 Then MsgBox "Arabic Keyboard not available.", , "ERROR!"
        If .EnglishID = 0 Then MsgBox "English Keyboard not available.", , "ERROR!"
    End With

End Sub

Private Sub RestoreDefaultKeyBoard()
    Const KLF_SETFORPROCESS = &H100
    Const KLF_ACTIVATE = &H1
    Call ActivateKeyboardLayout(initKbLayout, KLF_ACTIVATE + KLF_SETFORPROCESS)
End Sub

Private Sub ChangeLanguage(Optional ByVal Lang As LangEnum)
    Const KLF_SETFORPROCESS = &H100
    Const KLF_ACTIVATE = &H1
  
    If Lang = [_Default] Then Lang = initKbLayout
    If Lang = English Then Lang = tLangIds.EnglishID
    If Lang = Arabic Then Lang = tLangIds.ArabicID
    Call ActivateKeyboardLayout(Lang, KLF_ACTIVATE + KLF_SETFORPROCESS)
End Sub

Private Sub AlternateLangs()
    If LOWORD(CLng(GetKeyboardLayout(0))) = tLangIds.EnglishID Then
        Call ChangeLanguage(Arabic)
    ElseIf LOWORD(CLng(GetKeyboardLayout(0))) = tLangIds.ArabicID Then
        Call ChangeLanguage(English)
    End If
End Sub

#If Win64 Then
    Private Function GetKeyboardLayouts() As LongLong()
    Dim Layouts() As LongLong
#Else
    Private Function GetKeyboardLayouts() As Long()
    Dim Layouts() As Long
#End If

    Dim lLayoutsCount As Long
  
    lLayoutsCount = GetKeyboardLayoutList(0, ByVal 0)
    If (lLayoutsCount) Then
        ReDim Layouts(lLayoutsCount - 1)
        Call GetKeyboardLayoutList(lLayoutsCount, Layouts(0))
        GetKeyboardLayouts = Layouts
    End If

End Function

Private Function LOWORD(dw As Long) As Integer
    If dw And &H8000& Then
        LOWORD = dw Or &HFFFF0000
    Else
        LOWORD = dw And &HFFFF&
    End If
End Function

 

[Hasson]

I am sorry for not getting back to you sooner... I was busy.

don't worry I trust you will come back for me.
awesome ! this work is masterpiece .
thanks very much for your solution

 

[Jaafar Tribak]

don't worry I trust you will come back for me.
awesome ! this work is masterpiece .
thanks very much for your solution

Glad it is working for you and thanks for the feedback.