با سلام
این نمونه فایلی است که قبلا سرکار خانم خاکزاد زحمت تهیه آنرا تقبل کرده اند.
حال با یک تغییر کوچک به خواسته شما تغییر یافت
کد PHP:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
On Error Resume Next
If Not Application.Intersect(Target, Range("b2")) Is Nothing Or _
Not Application.Intersect(Target, Range("g2")) Is Nothing Then
changelanguage
Else
changelanguage2
End If
On Error GoTo 0
End Sub
کد PHP:
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
Const KLF_ACTIVATE = &H1
Global Const LANG_ENGLISH As String = "00000409"
Global Const LANG_persian As String = "00000429"
Sub changelanguage()
If Application.LanguageSettings.LanguagePreferredForEditing(msoLanguageIDEnglishUS) Then
SwitchKeyboardLang (LANG_persian)
End If
End Sub
'End Sub'
Function SwitchKeyboardLang(ByVal strLangID As String) As Boolean
Dim strRet As String
On Error Resume Next
strRet = String(9, 0)
GetKeyboardLayoutName strRet
If strRet = (strLangID & Chr(0)) Then
SwitchKeyboardLang = True
Exit Function
Else
strRet = String(9, 0)
strRet = LoadKeyboardLayout((strLangID & Chr(0)), KLF_ACTIVATE)
End If
GetKeyboardLayoutName strRet
If strRet = (strLangID) Then
SwitchKeyboardLang = True
End If
End Function
Sub changelanguage2()
If Application.LanguageSettings.LanguagePreferredForEditing(msoLanguageIDEnglishUS) Then
SwitchKeyboardLang (LANG_ENGLISH)
End If
End Sub
پاسخ با نقل قول
علاقه مندی ها (Bookmarks)