اذهب الي المحتوي
أوفيسنا
بحث مخصص من جوجل فى أوفيسنا
Custom Search

الردود الموصى بها

قام بنشر

السلام عليكم ورحمة الله تعالى وبركاته

بعد مرورى على موضوع استاذى الجليل واخى الحبيب الاستاذ @Foksh :fff:

والموضوع هو فى هذه >---->>   المشاركة من هنا

طلبت منه العب شويه بعد الاطلاع والتجربه على افكاره النيره وتطبيقه الاكثر من رائع وبجد الاول فى عرض فكرته تقريبا 

ولكن لن يكون الأخير :jump::wavetowel: فنحن هنا وحتما ولابد أن نضع بصمتنا

زعق لى وقالى اجرى العب بعيد ياض من هنا لحسن ارش ميه 😡

قلت اجى العب هنا لحالى ولوحدى :yes: :biggrin2:

 

- وظيفة المرفق هى : ضبط وتعديل اللغة المستخدمة في البرامج غير الموحدة ( language for non-Unicode programs )

بس خلاص واترككم واتمنى لكم تجربة ممتعه شيقة مع المرفق الذى يحتوى على نموذجين 

الاول بالعربى لمن يريد  ,  والثانى بالانجليزية لمن يريد 

فى انتظار أرائكم يا سادة 

ونحن لا نقيد أحد بل نضع الافكار بأكبر قدر ممكن من المرونة التى يمكن الحصول عليها والتعامل على هذا الاساس

الاكود المستخدمة للنموذج الانجليزى 

' Define constant messages to be used in the program
Private Const MSG_RESTART_SOON As String = "The computer will restart in 15 seconds"
Private Const MSG_SAVE_FILES As String = "Please save all open files"
Private Const MSG_CANT_RUN As String = "Your project cannot run without changing the system locale to Arabic"

' Define API functions based on the VBA version
#If VBA7 Then
    ' 64-bit version
    Private Declare PtrSafe Function RegOpenKeyEx Lib "advapi32.dll" Alias "RegOpenKeyExA" ( _
        ByVal hKey As LongPtr, _
        ByVal lpSubKey As String, _
        ByVal ulOptions As Long, _
        ByVal samDesired As Long, _
        ByRef phkResult As LongPtr) As Long

    Private Declare PtrSafe Function RegQueryValueEx Lib "advapi32.dll" Alias "RegQueryValueExA" ( _
        ByVal hKey As LongPtr, _
        ByVal lpValueName As String, _
        ByVal lpReserved As Long, _
        ByRef lpType As Long, _
        ByVal lpData As String, _
        ByRef lpcbData As Long) As Long

    Private Declare PtrSafe Function RegCloseKey Lib "advapi32.dll" ( _
        ByVal hKey As LongPtr) As Long

    Private Declare PtrSafe Function GetUserDefaultUILanguage Lib "kernel32" () As Long
    Private Declare PtrSafe Function GetACP Lib "kernel32" () As Long
    Private Declare PtrSafe Function GetUserDefaultLCID Lib "kernel32" () As Long
#Else
    ' 32-bit version
    Private Declare Function RegOpenKeyEx Lib "advapi32.dll" Alias "RegOpenKeyExA" ( _
        ByVal hKey As Long, _
        ByVal lpSubKey As String, _
        ByVal ulOptions As Long, _
        ByVal samDesired As Long, _
        ByRef phkResult As Long) As Long

    Private Declare Function RegQueryValueEx Lib "advapi32.dll" Alias "RegQueryValueExA" ( _
        ByVal hKey As Long, _
        ByVal lpValueName As String, _
        ByVal lpReserved As Long, _
        ByRef lpType As Long, _
        ByVal lpData As String, _
        ByRef lpcbData As Long) As Long

    Private Declare Function RegCloseKey Lib "advapi32.dll" ( _
        ByVal hKey As Long) As Long

    Private Declare Function GetUserDefaultUILanguage Lib "kernel32" () As Long
    Private Declare Function GetACP Lib "kernel32" () As Long
    Private Declare Function GetUserDefaultLCID Lib "kernel32" () As Long
#End If

' Constants for use with Windows API
Private Const HKEY_LOCAL_MACHINE As Long = &H80000002
Private Const KEY_QUERY_VALUE As Long = &H1
Private Const KEY_WOW64_64KEY As Long = &H100
Private Const KEY_WOW64_32KEY As Long = &H200
Private Const REG_SZ As Long = 1

' Define a custom type "country" to store country information
Private Type country
    countryCode As String        ' Country code (e.g., "EG")
    countryName As String        ' Country name (e.g., "Egypt")
    fullCountryName As String    ' Full country name (e.g., "Arab Republic of Egypt")
    localeName As String         ' Locale name (e.g., "ar-EG")
    localeID As String           ' Locale ID (e.g., "00000C01")
    code As String               ' Country calling code (e.g., "20")
    nativeLanguage As String     ' Native language with country (e.g., "Arabic (Egypt)")
End Type

' Define an array to store country settings
Private countries() As country

' Define a variable to store the current country settings
Private countrySettings As country

Private Sub SetCountryData(countryCode As String, countryName As String, fullCountryName As String, localeName As String, localeID As String, code As String, nativeLanguage As String)
    ' Define a variable of type "country" to store the current country data
    Dim currentCountry As country

    ' Assign data values to the currentCountry variable
    currentCountry.countryCode = countryCode        ' Country code
    currentCountry.countryName = countryName        ' Country name
    currentCountry.fullCountryName = fullCountryName ' Full country name
    currentCountry.localeName = localeName          ' Locale name
    currentCountry.localeID = localeID              ' Locale ID
    currentCountry.code = code                      ' Country calling code
    currentCountry.nativeLanguage = nativeLanguage  ' Native language with country
    
    ' Increase the size of the "countries" array while preserving existing data (ReDim Preserve)
    ReDim Preserve countries(UBound(countries) + 1)

    ' Add the current country data to the array
    countries(UBound(countries)) = currentCountry
End Sub

' Function to check the current system language
Private Function IsSystemLanguage(ByVal targetLocaleName As String, ByVal targetLocaleID As String) As Boolean
    ' Define variables
    Dim wshShell As Object           ' WScript.Shell object to access the system registry
    Dim currentLocaleName As String  ' To store the current system LocaleName
    Dim currentLocaleID As String    ' To store the current system LocaleID

    ' Create a WScript.Shell object
    Set wshShell = CreateObject("WScript.Shell")

    ' Temporarily ignore errors to avoid program stoppage if registry keys are missing
    On Error Resume Next

    ' Read the LocaleName value from the system registry
    currentLocaleName = wshShell.RegRead("HKEY_CURRENT_USER\Control Panel\International\LocaleName")

    ' Read the LocaleID value from the system registry
    currentLocaleID = wshShell.RegRead("HKEY_LOCAL_MACHINE\SYSTEM\CurrentControlSet\Control\Nls\Language\Default")

    ' Re-enable normal error handling
    On Error GoTo 0

    ' Compare the current LocaleName and LocaleID with the target values
    If currentLocaleName = targetLocaleName And currentLocaleID = targetLocaleID Then
        ' If the values match, return True
        IsSystemLanguage = True
    Else
        ' If the values do not match, return False
        IsSystemLanguage = False
    End If
End Function

Private Sub CheckSystemLanguage()
    ' Define variables
    Dim targetLocaleName As String  ' To store the target LocaleName
    Dim targetLocaleID As String    ' To store the target LocaleID
    Dim isLanguageMatch As Boolean  ' To store the result of the language check

    ' Set the target values
    targetLocaleName = "en-US" ' Target language: English - United States
    targetLocaleID = "0409"    ' Target language ID: English - United States

    ' Call the IsSystemLanguage function to check if the language matches
    isLanguageMatch = IsSystemLanguage(targetLocaleName, targetLocaleID)

    ' Display the result based on the function's return value
    If isLanguageMatch Then
        ' If the language matches, show a confirmation message
        MsgBox "The system language matches the target language: " & targetLocaleName, vbInformation, "Language Check"
    Else
        ' If the language does not match, show a warning message with details
        MsgBox "The system language does NOT match the target language: " & targetLocaleName & vbNewLine & _
               "Current Locale Name: " & targetLocaleName & vbNewLine & _
               "Current Locale ID: " & targetLocaleID, vbExclamation, "Language Check"
    End If
End Sub

Private Sub LogError(ByVal errorMessage As String)
    ' Temporarily ignore errors to avoid program stoppage if an error occurs during logging
    On Error Resume Next

    ' Define variables
    Dim fso As Object          ' FileSystemObject to handle files
    Dim logFile As Object      ' TextStream object to write data to the file
    Dim desktopPath As String  ' Desktop path
    Dim logFilePath As String  ' Full path to the error log file

    ' Get the desktop path using WScript.Shell
    desktopPath = CreateObject("WScript.Shell").SpecialFolders("Desktop")

    ' Define the full path to the error log file
    logFilePath = desktopPath & "\ChangeLanguageErrorLog.txt"

    ' Create a FileSystemObject to handle files
    Set fso = CreateObject("Scripting.FileSystemObject")

    ' Open the error log file for writing (8 means append, True means create the file if it doesn't exist)
    Set logFile = fso.OpenTextFile(logFilePath, 8, True)

    ' Write the error message and timestamp to the file
    logFile.WriteLine "Error: " & errorMessage & vbCrLf & "Timestamp: " & Now

    ' Close the file after writing
    logFile.Close

    ' Re-enable normal error handling
    On Error GoTo 0
End Sub

Private Sub ChangeSystemLanguage(Optional restartDelay As Integer = 15)
    ' Error handling: If an error occurs, go to ErrorHandler
    On Error GoTo ErrorHandler

    ' Define variables
    Dim fso As Object           ' FileSystemObject to handle files
    Dim batFile As Object       ' TextStream object to write the batch file
    Dim logFile As Object       ' TextStream object to write the log file
    Dim desktopPath As String   ' Desktop path
    Dim batFilePath As String   ' Full path to the batch file
    Dim logFilePath As String   ' Full path to the log file
    Dim newLanguage As String   ' New language (not used in the current code)

    Dim countryCode As String   ' Country code
    Dim localeID As String      ' Locale ID
    Dim localeName As String    ' Locale name
    Dim countryName As String   ' Country name

    ' Get the details of the selected country
    countryCode = countrySettings.countryCode
    localeID = countrySettings.localeID
    localeName = countrySettings.localeName
    countryName = countrySettings.countryName

    ' Get the desktop path
    desktopPath = CreateObject("WScript.Shell").SpecialFolders("Desktop")
    batFilePath = desktopPath & "\ChangeLanguage.bat"
    logFilePath = desktopPath & "\ChangeLanguageLog.txt"
    
    ' Create a FileSystemObject
    Set fso = CreateObject("Scripting.FileSystemObject")

    ' Create the batch file
    Set batFile = fso.CreateTextFile(batFilePath, True)

    ' Open the log file for appending
    Set logFile = fso.OpenTextFile(logFilePath, 8, True)

    ' Write commands to the batch file
    With batFile
        .WriteLine "@echo off"  ' Disable command display in the command window
        .WriteLine "chcp 1256"  ' Change the code page to 1256 (for Arabic support)
        .WriteLine "reg add ""HKLM\SYSTEM\CurrentControlSet\Control\Nls\Language"" /v Default /t REG_SZ /d " & localeID & " /f"
        .WriteLine "reg add ""HKLM\SYSTEM\CurrentControlSet\Control\Nls\Language"" /v InstallLanguage /t REG_SZ /d " & localeID & " /f"
        .WriteLine "reg add ""HKCU\Control Panel\International"" /v LocaleName /t REG_SZ /d " & localeName & " /f"
        .WriteLine "reg add ""HKCU\Control Panel\International"" /v Locale /t REG_SZ /d " & localeID & " /f"
        .WriteLine "reg add ""HKCU\Control Panel\International"" /v sCountry /t REG_SZ /d " & countryName & " /f"
        .WriteLine "shutdown /r /f /t " & restartDelay  ' Restart the computer after a specified delay
        .Close  ' Close the batch file
    End With

    ' Execute the batch file to change the language and restart
    Shell batFilePath, vbNormalFocus

    ' Notify the user about the language change and restart
    MsgBox "Language change is in progress. Your computer will restart in " & restartDelay & " seconds.", vbInformation, "Changing Language"

    ' Exit the procedure without executing the error handler code
    Exit Sub

ErrorHandler:
    ' Log the error in the log file
    LogError "Error in ChangeSystemLanguage: " & Err.Description

    ' Show an error message to the user
    MsgBox "An error occurred while changing the system language.", vbCritical
End Sub

Private Function IsArabicLanguage() As Boolean
    ' Define a variable to store the current system code page
    Dim CodePage As Long

    ' Get the current code page using the GetACP function
    CodePage = GetACP()

    ' Check if the code page is 1256 (Arabic)
    IsArabicLanguage = (CodePage = 1256)
End Function

Private Function GetArabicCountrySettings(ByVal countryCode As String) As country
    ' Search for the country in the array based on the country code
    Dim i As Integer
    For i = 0 To UBound(countries)
        If UCase(countries(i).countryName) = UCase(countryCode) Then
            ' If the country is found, return its details
            GetArabicCountrySettings = countries(i)
            Exit Function
        End If
    Next i

    ' If the country is not found, return Saudi Arabia as the default
    GetArabicCountrySettings = countries(4) ' Saudi Arabia
End Function

Sub LoadCountries()
    ' Error handling: If an error occurs, go to ErrorHandler
    On Error GoTo ErrorHandler

    ' Initialize the size of the countries array
    ReDim countries(0)

    ' Add country data to the array using the SetCountryData function
    ' Arabic Countries
    SetCountryData "AE", "UAE", "United Arab Emirates", "ar-AE", "00003801", "971", "Arabic (UAE)"
    SetCountryData "BH", "Bahrain", "Bahrain", "ar-BH", "00003C01", "973", "Arabic (Bahrain)"
    SetCountryData "DZ", "Algeria", "Algeria", "ar-DZ", "00001401", "213", "Arabic (Algeria)"
    SetCountryData "EG", "Egypt", "Egypt", "ar-EG", "00000C01", "20", "Arabic (Egypt)"
    SetCountryData "IQ", "Iraq", "Iraq", "ar-IQ", "00000801", "964", "Arabic (Iraq)"
    SetCountryData "JO", "Jordan", "Jordan", "ar-JO", "00000409", "962", "Arabic (Jordan)"
    SetCountryData "KW", "Kuwait", "Kuwait", "ar-KW", "00003401", "965", "Arabic (Kuwait)"
    SetCountryData "LB", "Lebanon", "Lebanon", "ar-LB", "00003001", "961", "Arabic (Lebanon)"
    SetCountryData "LY", "Libya", "Libya", "ar-LY", "00001001", "218", "Arabic (Libya)"
    SetCountryData "MA", "Morocco", "Morocco", "ar-MA", "00001801", "212", "Arabic (Morocco)"
    SetCountryData "MR", "Mauritania", "Mauritania", "ar-MR", "00001801", "222", "Arabic (Mauritania)"
    SetCountryData "OM", "Oman", "Oman", "ar-OM", "00002001", "968", "Arabic (Oman)"
    SetCountryData "PS", "Palestine", "Palestine", "ar-PS", "00000401", "970", "Arabic (Palestine)"
    SetCountryData "QA", "Qatar", "Qatar", "ar-QA", "00004001", "974", "Arabic (Qatar)"
    SetCountryData "SA", "Saudi Arabia", "Saudi Arabia", "ar-SA", "00000401", "966", "Arabic (Saudi Arabia)"
    SetCountryData "SD", "Sudan", "Sudan", "ar-SD", "00002C01", "249", "Arabic (Sudan)"
    SetCountryData "SO", "Somalia", "Somalia", "ar-SO", "00000401", "252", "Arabic (Somalia)"
    SetCountryData "SY", "Syria", "Syria", "ar-SY", "00002801", "963", "Arabic (Syria)"
    SetCountryData "TN", "Tunisia", "Tunisia", "ar-TN", "00001C01", "216", "Arabic (Tunisia)"
    SetCountryData "YE", "Yemen", "Yemen", "ar-YE", "00002401", "967", "Arabic (Yemen)"
    
    ' Chinese Countries
    SetCountryData "CN", "China", "China", "zh-CN", "00000804", "86", "Chinese (China)"
    SetCountryData "TW", "Taiwan", "Taiwan", "zh-TW", "00000404", "886", "Chinese (Taiwan)"
    SetCountryData "HK", "Hong Kong", "Hong Kong", "zh-HK", "00000C04", "852", "Chinese (Hong Kong)"
    SetCountryData "SG", "Singapore", "Singapore", "zh-SG", "00001004", "65", "Chinese (Singapore)"
    
    ' English Countries
    SetCountryData "AU", "Australia", "Australia", "en-AU", "00000C09", "61", "English (Australia)"
    SetCountryData "CA", "Canada", "Canada", "en-CA", "00001009", "1", "English (Canada)"
    SetCountryData "GB", "UK", "United Kingdom", "en-GB", "00000809", "44", "English (UK)"
    SetCountryData "IE", "Ireland", "Ireland", "en-IE", "00001809", "353", "English (Ireland)"
    SetCountryData "IN", "India", "India", "en-IN", "00000409", "91", "English (India)"
    SetCountryData "NG", "Nigeria", "Nigeria", "en-NG", "00000409", "234", "English (Nigeria)"
    SetCountryData "NZ", "New Zealand", "New Zealand", "en-NZ", "00001409", "64", "English (New Zealand)"
    SetCountryData "PH", "Philippines", "Philippines", "en-PH", "00000409", "63", "English (Philippines)"
    SetCountryData "US", "USA", "United States of America", "en-US", "00000409", "1", "English (US)"
    SetCountryData "ZA", "South Africa", "South Africa", "en-ZA", "00000409", "27", "English (South Africa)"
    
    ' French Countries
    SetCountryData "BE", "Belgium", "Belgium", "fr-BE", "0000080C", "32", "French (Belgium)"
    SetCountryData "CA", "Canada", "Canada", "fr-CA", "00000C0C", "1", "French (Canada)"
    SetCountryData "CH", "Switzerland", "Switzerland", "fr-CH", "0000100C", "41", "French (Switzerland)"
    SetCountryData "FR", "France", "France", "fr-FR", "0000040C", "33", "French (France)"
    SetCountryData "LU", "Luxembourg", "Luxembourg", "fr-LU", "0000140C", "352", "French (Luxembourg)"
    SetCountryData "SN", "Senegal", "Senegal", "fr-SN", "0000040C", "221", "French (Senegal)"
    
    ' German Countries
    SetCountryData "AT", "Austria", "Austria", "de-AT", "00000407", "43", "German (Austria)"
    SetCountryData "CH", "Switzerland", "Switzerland", "de-CH", "00000807", "41", "German (Switzerland)"
    SetCountryData "DE", "Germany", "Germany", "de-DE", "00000407", "49", "German (Germany)"
    SetCountryData "LI", "Liechtenstein", "Liechtenstein", "de-LI", "00001007", "423", "German (Liechtenstein)"
    
    ' Hindi Countries
    SetCountryData "IN", "India", "India", "hi-IN", "00000439", "91", "Hindi (India)"
    
    ' Indonesian Countries
    SetCountryData "ID", "Indonesia", "Indonesia", "id-ID", "00000421", "62", "Indonesian (Indonesia)"
    
    ' Italian Countries
    SetCountryData "IT", "Italy", "Italy", "it-IT", "00000410", "39", "Italian (Italy)"
    SetCountryData "SM", "San Marino", "San Marino", "it-SM", "00000410", "378", "Italian (San Marino)"
    SetCountryData "VA", "Vatican City", "Vatican City", "it-VA", "00000410", "379", "Italian (Vatican City)"
    
    ' Japanese Countries
    SetCountryData "JP", "Japan", "Japan", "ja-JP", "00000411", "81", "Japanese (Japan)"
    
    ' Korean Countries
    SetCountryData "KR", "South Korea", "South Korea", "ko-KR", "00000412", "82", "Korean (South Korea)"
    SetCountryData "KP", "North Korea", "North Korea", "ko-KP", "00000412", "850", "Korean (North Korea)"
    
    ' Portuguese Countries
    SetCountryData "BR", "Brazil", "Brazil", "pt-BR", "00000416", "55", "Portuguese (Brazil)"
    SetCountryData "PT", "Portugal", "Portugal", "pt-PT", "00000816", "351", "Portuguese (Portugal)"
    SetCountryData "AO", "Angola", "Angola", "pt-AO", "00000416", "244", "Portuguese (Angola)"
    SetCountryData "MZ", "Mozambique", "Mozambique", "pt-MZ", "00000416", "258", "Portuguese (Mozambique)"
    
    ' Russian Countries
    SetCountryData "RU", "Russia", "Russia", "ru-RU", "00000419", "7", "Russian (Russia)"
    SetCountryData "BY", "Belarus", "Belarus", "ru-BY", "00000419", "375", "Russian (Belarus)"
    SetCountryData "KZ", "Kazakhstan", "Kazakhstan", "ru-KZ", "00000419", "7", "Russian (Kazakhstan)"
    SetCountryData "KG", "Kyrgyzstan", "Kyrgyzstan", "ru-KG", "00000419", "996", "Russian (Kyrgyzstan)"
    
    ' Spanish Countries
    SetCountryData "AR", "Argentina", "Argentina", "es-AR", "00002C0A", "54", "Spanish (Argentina)"
    SetCountryData "BO", "Bolivia", "Bolivia", "es-BO", "00002C0A", "591", "Spanish (Bolivia)"
    SetCountryData "CL", "Chile", "Chile", "es-CL", "00002C0A", "56", "Spanish (Chile)"
    SetCountryData "CO", "Colombia", "Colombia", "es-CO", "00002C0A", "57", "Spanish (Colombia)"
    SetCountryData "CR", "Costa Rica", "Costa Rica", "es-CR", "00002C0A", "506", "Spanish (Costa Rica)"
    SetCountryData "CU", "Cuba", "Cuba", "es-CU", "00002C0A", "53", "Spanish (Cuba)"
    SetCountryData "DO", "Dominican Republic", "Dominican Republic", "es-DO", "00002C0A", "1", "Spanish (Dominican Republic)"
    SetCountryData "EC", "Ecuador", "Ecuador", "es-EC", "00002C0A", "593", "Spanish (Ecuador)"
    SetCountryData "ES", "Spain", "Spain", "es-ES", "0000040A", "34", "Spanish (Spain)"
    SetCountryData "GT", "Guatemala", "Guatemala", "es-GT", "00002C0A", "502", "Spanish (Guatemala)"
    SetCountryData "HN", "Honduras", "Honduras", "es-HN", "00002C0A", "504", "Spanish (Honduras)"
    SetCountryData "MX", "Mexico", "Mexico", "es-MX", "0000080A", "52", "Spanish (Mexico)"
    SetCountryData "NI", "Nicaragua", "Nicaragua", "es-NI", "00002C0A", "505", "Spanish (Nicaragua)"
    SetCountryData "PA", "Panama", "Panama", "es-PA", "00002C0A", "507", "Spanish (Panama)"
    SetCountryData "PE", "Peru", "Peru", "es-PE", "00002C0A", "51", "Spanish (Peru)"
    SetCountryData "PR", "Puerto Rico", "Puerto Rico", "es-PR", "00002C0A", "1", "Spanish (Puerto Rico)"
    SetCountryData "PY", "Paraguay", "Paraguay", "es-PY", "00002C0A", "595", "Spanish (Paraguay)"
    SetCountryData "SV", "El Salvador", "El Salvador", "es-SV", "00002C0A", "503", "Spanish (El Salvador)"
    SetCountryData "UY", "Uruguay", "Uruguay", "es-UY", "00002C0A", "598", "Spanish (Uruguay)"
    SetCountryData "VE", "Venezuela", "Venezuela", "es-VE", "00002C0A", "58", "Spanish (Venezuela)"
    
    ' Turkish Countries
    SetCountryData "TR", "Turkey", "Turkey", "tr-TR", "0000041F", "90", "Turkish (Turkey)"
    SetCountryData "CY", "Cyprus", "Cyprus", "tr-CY", "0000041F", "357", "Turkish (Cyprus)"

    ' Check if the cmbLanguage control exists in the form
    If Not Me.cmbLanguage Is Nothing Then
        ' Clear old items from the combo box
        Me.cmbLanguage = ""

        ' Populate the combo box with full country names from the array
        Dim i As Integer
        For i = 1 To UBound(countries)
            Me.cmbLanguage.AddItem countries(i).nativeLanguage
        Next i
    Else
        ' Show an error message if the combo box is not found
        MsgBox "The combo box 'cmbLanguage' could not be found.", vbCritical
    End If

    ' Exit the procedure without executing the error handler code
    Exit Sub

ErrorHandler:
    ' Log the error using the LogError function
    LogError "Error in LoadCountries: " & Err.Description

    ' Show an error message to the user
    MsgBox "An error occurred while loading countries.", vbCritical
End Sub

Private Sub Form_Load()
    ' Load country names into the combo box
    LoadCountries

    ' Set the default language (Egypt) in the combo box
    cmbLanguage.Value = "Arabic (Egypt)"

    ' Set the default country details (Egypt)
    countrySettings = GetArabicCountrySettings("EG")

    ' Display the country name in the text box
    txtConteryName.Value = GetNonUnicodeLanguage()
End Sub

Private Sub cmbLanguage_Change()
    ' Error handling: If an error occurs, go to ErrorHandler
    On Error GoTo ErrorHandler

    ' Get the selected country name from the combo box
    Dim selectedCountryName As String
    selectedCountryName = Me.cmbLanguage.Value

    ' Search for the selected country in the array
    Dim i As Integer
    For i = 1 To UBound(countries)
        If countries(i).nativeLanguage = selectedCountryName Then
            ' If the country is found, save its details
            countrySettings = countries(i)
            Exit For
        End If
    Next i

    ' Display a message based on the search result
    If i <= UBound(countries) Then
        MsgBox "Selected language: " & selectedCountryName, vbInformation, "Language Selected"
    Else
        MsgBox "The language was not found in the list.", vbExclamation, "Error"
    End If

    ' Exit the procedure without executing the error handler code
    Exit Sub

ErrorHandler:
    ' Show an error message if a problem occurs
    MsgBox "An error occurred while selecting the language.", vbCritical, "Error"
End Sub

Private Sub btnLanguage_Click()
    ' Error handling: If an error occurs, go to ErrorHandler
    On Error GoTo ErrorHandler

    ' Check if a language has been selected from the list
    If countrySettings.countryCode = "" Then
        MsgBox "Please select a language from the list.", vbExclamation, "Language Selection"
        Exit Sub
    End If

    ' Execute the language change with a 15-second delay before restarting
    Call ChangeSystemLanguage(15)

    ' Notify the user that the language change will occur and the system will restart soon
    MsgBox "The language has been successfully selected. The system will restart in 15 seconds.", vbInformation, "Language Change"

    ' Exit the procedure without executing the error handler code
    Exit Sub

ErrorHandler:
    ' Show an error message if a problem occurs
    MsgBox "An error occurred while attempting to change the language.", vbCritical, "Error"
End Sub

Private Function GetRegistryValue(ByVal keyPath As String, ByVal valueName As String) As String
    
#If VBA7 Then
    ' 64-bit version
    Dim hKey As LongPtr
#Else
    ' 32-bit version
    Dim hKey As Long
#End If
    
    Dim ret As Long
    Dim valueType As Long
    Dim valueData As String
    Dim dataLength As Long
    
    ' Open the registry key
    ret = RegOpenKeyEx(HKEY_LOCAL_MACHINE, keyPath, 0, KEY_QUERY_VALUE Or KEY_WOW64_64KEY, hKey)
    
    If ret = 0 Then
        ' Determine the data size
        ret = RegQueryValueEx(hKey, valueName, 0, valueType, vbNullString, dataLength)
        
        If ret = 0 And valueType = REG_SZ Then
            ' Read the data
            valueData = String(dataLength, Chr(0))
            ret = RegQueryValueEx(hKey, valueName, 0, valueType, valueData, dataLength)
            
            If ret = 0 Then
                ' Remove trailing null characters
                GetRegistryValue = Left(valueData, dataLength - 1)
            End If
        End If
        
        ' Close the registry key
        RegCloseKey (hKey)
    End If
End Function

Private Function GetNonUnicodeLanguage() As String
    Dim localeID As String
    ' Read the registry value
    localeID = GetRegistryValue("SYSTEM\CurrentControlSet\Control\Nls\Language", "Default")
    
    ' Convert the value to Long
    Dim localeIDLong As Long
    localeIDLong = Val("&H" & localeID)
    
    ' Use Locale ID to determine the language
    Select Case localeIDLong
        ' Arabic Countries
        Case &H401: GetNonUnicodeLanguage = "Arabic (Saudi Arabia)"
        Case &H801: GetNonUnicodeLanguage = "Arabic (Iraq)"
        Case &HC01: GetNonUnicodeLanguage = "Arabic (Egypt)"
        Case &H1001: GetNonUnicodeLanguage = "Arabic (Libya)"
        Case &H1401: GetNonUnicodeLanguage = "Arabic (Algeria)"
        Case &H1801: GetNonUnicodeLanguage = "Arabic (Morocco)"
        Case &H1C01: GetNonUnicodeLanguage = "Arabic (Tunisia)"
        Case &H2001: GetNonUnicodeLanguage = "Arabic (Oman)"
        Case &H2401: GetNonUnicodeLanguage = "Arabic (Yemen)"
        Case &H2801: GetNonUnicodeLanguage = "Arabic (Syria)"
        Case &H2C01: GetNonUnicodeLanguage = "Arabic (Jordan)"
        Case &H3001: GetNonUnicodeLanguage = "Arabic (Lebanon)"
        Case &H3401: GetNonUnicodeLanguage = "Arabic (Kuwait)"
        Case &H3801: GetNonUnicodeLanguage = "Arabic (UAE)"
        Case &H3C01: GetNonUnicodeLanguage = "Arabic (Bahrain)"
        Case &H4001: GetNonUnicodeLanguage = "Arabic (Qatar)"
        
        ' English Countries
        Case &H409: GetNonUnicodeLanguage = "English (United States)"
        Case &H809: GetNonUnicodeLanguage = "English (United Kingdom)"
        Case &HC09: GetNonUnicodeLanguage = "English (Australia)"
        Case &H1009: GetNonUnicodeLanguage = "English (Canada)"
        Case &H1409: GetNonUnicodeLanguage = "English (New Zealand)"
        Case &H1809: GetNonUnicodeLanguage = "English (Ireland)"
        Case &H1C09: GetNonUnicodeLanguage = "English (South Africa)"
        Case &H2009: GetNonUnicodeLanguage = "English (Jamaica)"
        Case &H2409: GetNonUnicodeLanguage = "English (Caribbean)"
        Case &H2809: GetNonUnicodeLanguage = "English (Belize)"
        Case &H2C09: GetNonUnicodeLanguage = "English (Trinidad)"
        Case &H3009: GetNonUnicodeLanguage = "English (Zimbabwe)"
        Case &H3409: GetNonUnicodeLanguage = "English (Philippines)"
        Case &H3809: GetNonUnicodeLanguage = "English (India)"
        
        ' French Countries
        Case &H40C: GetNonUnicodeLanguage = "French (France)"
        Case &H80C: GetNonUnicodeLanguage = "French (Belgium)"
        Case &HC0C: GetNonUnicodeLanguage = "French (Canada)"
        Case &H100C: GetNonUnicodeLanguage = "French (Switzerland)"
        Case &H140C: GetNonUnicodeLanguage = "French (Luxembourg)"
        Case &H180C: GetNonUnicodeLanguage = "French (Monaco)"
        Case &H1C0C: GetNonUnicodeLanguage = "French (Senegal)"
        
        ' German Countries
        Case &H407: GetNonUnicodeLanguage = "German (Germany)"
        Case &H807: GetNonUnicodeLanguage = "German (Switzerland)"
        Case &HC07: GetNonUnicodeLanguage = "German (Austria)"
        Case &H1007: GetNonUnicodeLanguage = "German (Liechtenstein)"
        
        ' Hindi Countries
        Case &H439: GetNonUnicodeLanguage = "Hindi (India)"
        
        ' Indonesian Countries
        Case &H421: GetNonUnicodeLanguage = "Indonesian (Indonesia)"
        
        ' Italian Countries
        Case &H410: GetNonUnicodeLanguage = "Italian (Italy)"
        Case &H810: GetNonUnicodeLanguage = "Italian (Switzerland)"
        Case &HC10: GetNonUnicodeLanguage = "Italian (San Marino)"
        Case &H1010: GetNonUnicodeLanguage = "Italian (Vatican City)"
        
        ' Japanese Countries
        Case &H411: GetNonUnicodeLanguage = "Japanese (Japan)"
        
        ' Korean Countries
        Case &H412: GetNonUnicodeLanguage = "Korean (South Korea)"
        Case &H812: GetNonUnicodeLanguage = "Korean (North Korea)"
        
        ' Portuguese Countries
        Case &H416: GetNonUnicodeLanguage = "Portuguese (Brazil)"
        Case &H816: GetNonUnicodeLanguage = "Portuguese (Portugal)"
        Case &HC16: GetNonUnicodeLanguage = "Portuguese (Angola)"
        Case &H1016: GetNonUnicodeLanguage = "Portuguese (Mozambique)"
        
        ' Russian Countries
        Case &H419: GetNonUnicodeLanguage = "Russian (Russia)"
        Case &H819: GetNonUnicodeLanguage = "Russian (Belarus)"
        Case &HC19: GetNonUnicodeLanguage = "Russian (Kazakhstan)"
        Case &H1019: GetNonUnicodeLanguage = "Russian (Kyrgyzstan)"
        
        ' Spanish Countries
        Case &H40A: GetNonUnicodeLanguage = "Spanish (Spain)"
        Case &H80A: GetNonUnicodeLanguage = "Spanish (Mexico)"
        Case &HC0A: GetNonUnicodeLanguage = "Spanish (Argentina)"
        Case &H100A: GetNonUnicodeLanguage = "Spanish (Colombia)"
        Case &H140A: GetNonUnicodeLanguage = "Spanish (Peru)"
        Case &H180A: GetNonUnicodeLanguage = "Spanish (Venezuela)"
        Case &H1C0A: GetNonUnicodeLanguage = "Spanish (Chile)"
        Case &H200A: GetNonUnicodeLanguage = "Spanish (Ecuador)"
        Case &H240A: GetNonUnicodeLanguage = "Spanish (Guatemala)"
        Case &H280A: GetNonUnicodeLanguage = "Spanish (Cuba)"
        Case &H2C0A: GetNonUnicodeLanguage = "Spanish (Bolivia)"
        Case &H300A: GetNonUnicodeLanguage = "Spanish (Dominican Republic)"
        Case &H340A: GetNonUnicodeLanguage = "Spanish (Puerto Rico)"
        Case &H380A: GetNonUnicodeLanguage = "Spanish (Uruguay)"
        Case &H3C0A: GetNonUnicodeLanguage = "Spanish (Paraguay)"
        Case &H400A: GetNonUnicodeLanguage = "Spanish (Costa Rica)"
        Case &H440A: GetNonUnicodeLanguage = "Spanish (El Salvador)"
        Case &H480A: GetNonUnicodeLanguage = "Spanish (Honduras)"
        Case &H4C0A: GetNonUnicodeLanguage = "Spanish (Nicaragua)"
        Case &H500A: GetNonUnicodeLanguage = "Spanish (Panama)"
        
        ' Turkish Countries
        Case &H41F: GetNonUnicodeLanguage = "Turkish (Turkey)"
        Case &H81F: GetNonUnicodeLanguage = "Turkish (Cyprus)"
        
        ' Default Case
        Case Else: GetNonUnicodeLanguage = "Unknown (Locale ID: " & localeID & ")"
    End Select
End Function


الاكواد المستخدمة فى النموذج العربى 

Option Compare Database
Option Explicit

' تعريف الرسائل الثابتة التي سيتم استخدامها في البرنامج
Private Const MSG_RESTART_SOON As String = "سيتم إعادة تشغيل الكمبيوتر خلال 15 ثانية"
Private Const MSG_SAVE_FILES As String = "يرجى حفظ جميع الملفات المفتوحة"
Private Const MSG_CANT_RUN As String = "لا يمكن تشغيل المشروع دون تغيير لغة النظام إلى العربية"

' تعريف الدوال API بناءً على إصدار VBA
#If VBA7 Then
    ' إصدار 64 بت
    Private Declare PtrSafe Function RegOpenKeyEx Lib "advapi32.dll" Alias "RegOpenKeyExA" ( _
        ByVal hKey As LongPtr, _
        ByVal lpSubKey As String, _
        ByVal ulOptions As Long, _
        ByVal samDesired As Long, _
        ByRef phkResult As LongPtr) As Long

    Private Declare PtrSafe Function RegQueryValueEx Lib "advapi32.dll" Alias "RegQueryValueExA" ( _
        ByVal hKey As LongPtr, _
        ByVal lpValueName As String, _
        ByVal lpReserved As Long, _
        ByRef lpType As Long, _
        ByVal lpData As String, _
        ByRef lpcbData As Long) As Long

    Private Declare PtrSafe Function RegCloseKey Lib "advapi32.dll" ( _
        ByVal hKey As LongPtr) As Long

    Private Declare PtrSafe Function GetUserDefaultUILanguage Lib "kernel32" () As Long
    Private Declare PtrSafe Function GetACP Lib "kernel32" () As Long
    Private Declare PtrSafe Function GetUserDefaultLCID Lib "kernel32" () As Long
#Else
    ' إصدار 32 بت
    Private Declare Function RegOpenKeyEx Lib "advapi32.dll" Alias "RegOpenKeyExA" ( _
        ByVal hKey As Long, _
        ByVal lpSubKey As String, _
        ByVal ulOptions As Long, _
        ByVal samDesired As Long, _
        ByRef phkResult As Long) As Long

    Private Declare Function RegQueryValueEx Lib "advapi32.dll" Alias "RegQueryValueExA" ( _
        ByVal hKey As Long, _
        ByVal lpValueName As String, _
        ByVal lpReserved As Long, _
        ByRef lpType As Long, _
        ByVal lpData As String, _
        ByRef lpcbData As Long) As Long

    Private Declare Function RegCloseKey Lib "advapi32.dll" ( _
        ByVal hKey As Long) As Long

    Private Declare Function GetUserDefaultUILanguage Lib "kernel32" () As Long
    Private Declare Function GetACP Lib "kernel32" () As Long
    Private Declare Function GetUserDefaultLCID Lib "kernel32" () As Long
#End If

' ثوابت لاستخدامها مع Windows API
Private Const HKEY_LOCAL_MACHINE As Long = &H80000002
Private Const KEY_QUERY_VALUE As Long = &H1
Private Const KEY_WOW64_64KEY As Long = &H100
Private Const KEY_WOW64_32KEY As Long = &H200
Private Const REG_SZ As Long = 1

' تعريف نوع بيانات "country" لتخزين معلومات البلد
Private Type country
    countryCode As String        ' رمز البلد (مثال: "EG")
    countryName As String        ' اسم البلد (مثال: "مصر")
    fullCountryName As String    ' الاسم الكامل للبلد (مثال: "جمهورية مصر العربية")
    localeName As String         ' اسم اللغة المحلية (مثال: "ar-EG")
    localeID As String           ' معرف اللغة المحلية (مثال: "00000C01")
    code As String               ' رمز الاتصال بالبلد (مثال: "20")
    nativeLanguage As String     ' اللغة الأم مع البلد (مثال: "العربية (مصر)")
End Type

' تعريف مصفوفة لتخزين إعدادات البلدان
Private countries() As country

' تعريف متغير لتخزين إعدادات البلد الحالية
Private countrySettings As country

Private Sub LogError(ByVal errorMessage As String)
    ' تجاهل الأخطاء مؤقتًا لتجنب توقف البرنامج في حالة حدوث خطأ أثناء تسجيل الخطأ
    On Error Resume Next

    ' تعريف المتغيرات
    Dim fso As Object          ' كائن FileSystemObject للتعامل مع الملفات
    Dim logFile As Object      ' كائن TextStream لكتابة البيانات في الملف
    Dim desktopPath As String  ' مسار سطح المكتب
    Dim logFilePath As String  ' المسار الكامل لملف تسجيل الأخطاء

    ' الحصول على مسار سطح المكتب باستخدام WScript.Shell
    desktopPath = CreateObject("WScript.Shell").SpecialFolders("Desktop")

    ' تحديد المسار الكامل لملف تسجيل الأخطاء
    logFilePath = desktopPath & "\ChangeLanguageErrorLog.txt"

    ' إنشاء كائن FileSystemObject للتعامل مع الملفات
    Set fso = CreateObject("Scripting.FileSystemObject")

    ' فتح ملف تسجيل الأخطاء للكتابة (الرقم 8 يعني الإلحاق، True يعني إنشاء الملف إذا لم يكن موجودًا)
    Set logFile = fso.OpenTextFile(logFilePath, 8, True)

    ' كتابة رسالة الخطأ والطابع الزمني في الملف
    logFile.WriteLine "Error: " & errorMessage & vbCrLf & "Timestamp: " & Now

    ' إغلاق الملف بعد الانتهاء من الكتابة
    logFile.Close

    ' إعادة تفعيل معالجة الأخطاء العادية
    On Error GoTo 0
End Sub

Private Sub SetCountryData(countryCode As String, countryName As String, fullCountryName As String, localeName As String, localeID As String, code As String, nativeLanguage As String)
    ' تعريف متغير من النوع "country" لتخزين بيانات البلد الحالي
    Dim currentCountry As country

    ' تعيين قيم البيانات إلى المتغير currentCountry
    currentCountry.countryCode = countryCode        ' رمز البلد
    currentCountry.countryName = countryName        ' اسم البلد
    currentCountry.fullCountryName = fullCountryName ' الاسم الكامل للبلد
    currentCountry.localeName = localeName          ' اسم اللغة المحلية
    currentCountry.localeID = localeID              ' معرف اللغة المحلية
    currentCountry.code = code                      ' رمز الاتصال بالبلد
    currentCountry.nativeLanguage = nativeLanguage  ' اللغة الأم مع البلد
    
    ' زيادة حجم المصفوفة "countries" مع الاحتفاظ بالبيانات الموجودة (ReDim Preserve)
    ReDim Preserve countries(UBound(countries) + 1)

    ' إضافة بيانات البلد الحالي إلى المصفوفة
    countries(UBound(countries)) = currentCountry
End Sub

' دالة للتحقق من لغة النظام الحالية
Private Function IsSystemLanguage(ByVal targetLocaleName As String, ByVal targetLocaleID As String) As Boolean
    ' تعريف المتغيرات
    Dim wshShell As Object           ' كائن WScript.Shell للوصول إلى سجل النظام
    Dim currentLocaleName As String  ' لتخزين LocaleName الحالي للنظام
    Dim currentLocaleID As String    ' لتخزين LocaleID الحالي للنظام

    ' إنشاء كائن WScript.Shell
    Set wshShell = CreateObject("WScript.Shell")

    ' تجاهل الأخطاء مؤقتًا لتجنب توقف البرنامج في حالة عدم وجود مفاتيح السجل
    On Error Resume Next

    ' قراءة قيمة LocaleName من سجل النظام
    currentLocaleName = wshShell.RegRead("HKEY_CURRENT_USER\Control Panel\International\LocaleName")

    ' قراءة قيمة LocaleID من سجل النظام
    currentLocaleID = wshShell.RegRead("HKEY_LOCAL_MACHINE\SYSTEM\CurrentControlSet\Control\Nls\Language\Default")

    ' إعادة تفعيل معالجة الأخطاء العادية
    On Error GoTo 0

    ' مقارنة LocaleName و LocaleID الحاليين مع القيم المستهدفة
    If currentLocaleName = targetLocaleName And currentLocaleID = targetLocaleID Then
        ' إذا كانت القيم متطابقة، يتم إرجاع True
        IsSystemLanguage = True
    Else
        ' إذا كانت القيم غير متطابقة، يتم إرجاع False
        IsSystemLanguage = False
    End If
End Function

Private Sub CheckSystemLanguage()
    ' تعريف المتغيرات
    Dim targetLocaleName As String  ' لتخزين LocaleName المستهدف
    Dim targetLocaleID As String    ' لتخزين LocaleID المستهدف
    Dim isLanguageMatch As Boolean  ' لتخزين نتيجة التحقق من تطابق اللغة

    ' تحديد القيم المستهدفة
    targetLocaleName = "en-US" ' اللغة المستهدفة: الإنجليزية - الولايات المتحدة
    targetLocaleID = "0409"    ' معرف اللغة المستهدف: الإنجليزية - الولايات المتحدة

    ' استدعاء الدالة IsSystemLanguage للتحقق من تطابق اللغة
    isLanguageMatch = IsSystemLanguage(targetLocaleName, targetLocaleID)

    ' عرض النتيجة بناءً على ما تعيده الدالة
    If isLanguageMatch Then
        ' إذا كانت اللغة مطابقة، يتم عرض رسالة تأكيد
        MsgBox "لغة النظام مطابقة للغة المستهدفة: " & targetLocaleName, vbInformation, "التحقق من اللغة"
    Else
        ' إذا كانت اللغة غير مطابقة، يتم عرض رسالة تحذير مع تفاصيل
        MsgBox "لغة النظام غير مطابقة للغة المستهدفة: " & targetLocaleName & vbNewLine & _
               "اللغة الحالية: " & targetLocaleName & vbNewLine & _
               "معرف اللغة الحالي: " & targetLocaleID, vbExclamation, "التحقق من اللغة"
    End If
End Sub

Private Sub ChangeSystemLanguage(Optional restartDelay As Integer = 15)
    ' معالجة الأخطاء: في حالة حدوث خطأ، يتم الانتقال إلى ErrorHandler
    On Error GoTo ErrorHandler

    ' تعريف المتغيرات
    Dim fso As Object           ' كائن FileSystemObject للتعامل مع الملفات
    Dim batFile As Object       ' كائن TextStream لكتابة ملف الباتش
    Dim logFile As Object       ' كائن TextStream لكتابة ملف السجل
    Dim desktopPath As String   ' مسار سطح المكتب
    Dim batFilePath As String   ' المسار الكامل لملف الباتش
    Dim logFilePath As String   ' المسار الكامل لملف السجل
    Dim newLanguage As String   ' اللغة الجديدة (غير مستخدمة في الكود الحالي)

    Dim countryCode As String   ' رمز البلد
    Dim localeID As String      ' معرف اللغة المحلية
    Dim localeName As String    ' اسم اللغة المحلية
    Dim countryName As String   ' اسم البلد

    ' الحصول على تفاصيل البلد المحدد
    countryCode = countrySettings.countryCode
    localeID = countrySettings.localeID
    localeName = countrySettings.localeName
    countryName = countrySettings.countryName

    ' الحصول على مسار سطح المكتب
    desktopPath = CreateObject("WScript.Shell").SpecialFolders("Desktop")
    batFilePath = desktopPath & "\ChangeLanguage.bat"
    logFilePath = desktopPath & "\ChangeLanguageLog.txt"
    
    ' إنشاء كائن FileSystemObject
    Set fso = CreateObject("Scripting.FileSystemObject")

    ' إنشاء ملف الباتش
    Set batFile = fso.CreateTextFile(batFilePath, True)

    ' فتح ملف السجل للإلحاق (Append)
    Set logFile = fso.OpenTextFile(logFilePath, 8, True)

    ' كتابة الأوامر في ملف الباتش
    With batFile
        .WriteLine "@echo off"  ' إيقاف عرض الأوامر في نافذة الأوامر
        .WriteLine "chcp 1256"  ' تغيير صفحة الترميز إلى 1256 (للدعم العربي)
        .WriteLine "reg add ""HKLM\SYSTEM\CurrentControlSet\Control\Nls\Language"" /v Default /t REG_SZ /d " & localeID & " /f"
        .WriteLine "reg add ""HKLM\SYSTEM\CurrentControlSet\Control\Nls\Language"" /v InstallLanguage /t REG_SZ /d " & localeID & " /f"
        .WriteLine "reg add ""HKCU\Control Panel\International"" /v LocaleName /t REG_SZ /d " & localeName & " /f"
        .WriteLine "reg add ""HKCU\Control Panel\International"" /v Locale /t REG_SZ /d " & localeID & " /f"
        .WriteLine "reg add ""HKCU\Control Panel\International"" /v sCountry /t REG_SZ /d " & countryName & " /f"
        .WriteLine "shutdown /r /f /t " & restartDelay  ' إعادة تشغيل الكمبيوتر بعد تأخير محدد
        .Close  ' إغلاق ملف الباتش
    End With

    ' تنفيذ ملف الباتش لتغيير اللغة وإعادة التشغيل
    Shell batFilePath, vbNormalFocus

    ' إعلام المستخدم بتغيير اللغة وإعادة التشغيل
    MsgBox "جاري تغيير اللغة. سيتم إعادة تشغيل الكمبيوتر خلال " & restartDelay & " ثانية.", vbInformation, "تغيير اللغة"

    ' الخروج من الإجراء دون تنفيذ كود معالج الأخطاء
    Exit Sub

ErrorHandler:
    ' تسجيل الخطأ في ملف السجل
    LogError "حدث خطأ في ChangeSystemLanguage: " & Err.Description

    ' إظهار رسالة خطأ للمستخدم
    MsgBox "حدث خطأ أثناء محاولة تغيير لغة النظام.", vbCritical
End Sub

Private Function IsArabicLanguage() As Boolean
    ' تعريف المتغير لتخزين صفحة الترميز الحالية للنظام
    Dim CodePage As Long

    ' الحصول على صفحة الترميز الحالية باستخدام الدالة GetACP
    CodePage = GetACP()

    ' التحقق مما إذا كانت صفحة الترميز هي 1256 (العربية)
    IsArabicLanguage = (CodePage = 1256)
End Function

Private Function GetArabicCountrySettings(ByVal countryCode As String) As country
    ' البحث عن البلد في المصفوفة بناءً على رمز البلد
    Dim i As Integer
    For i = 0 To UBound(countries)
        If UCase(countries(i).countryName) = UCase(countryCode) Then
            ' إذا تم العثور على البلد، يتم إرجاع تفاصيله
            GetArabicCountrySettings = countries(i)
            Exit Function
        End If
    Next i

    ' إذا لم يتم العثور على البلد، يتم إرجاع السعودية كإعداد افتراضي
    GetArabicCountrySettings = countries(4) ' السعودية
End Function

Sub LoadCountries()
    ' معالجة الأخطاء: في حالة حدوث خطأ، يتم الانتقال إلى ErrorHandler
    On Error GoTo ErrorHandler

    ' تهيئة الحجم الأولي للمصفوفة countries
    ReDim countries(0)

    ' إضافة بيانات البلدان إلى المصفوفة باستخدام الدالة SetCountryData
    ' البلدان العربية
    SetCountryData "AE", "UAE", "الإمارات العربية المتحدة", "ar-AE", "00003801", "971", "العربية (الإمارات)"
    SetCountryData "BH", "Bahrain", "البحرين", "ar-BH", "00003C01", "973", "العربية (البحرين)"
    SetCountryData "DZ", "Algeria", "الجزائر", "ar-DZ", "00001401", "213", "العربية (الجزائر)"
    SetCountryData "EG", "Egypt", "مصر", "ar-EG", "00000C01", "20", "العربية (مصر)"
    SetCountryData "IQ", "Iraq", "العراق", "ar-IQ", "00000801", "964", "العربية (العراق)"
    SetCountryData "JO", "Jordan", "الأردن", "ar-JO", "00000409", "962", "العربية (الأردن)"
    SetCountryData "KW", "Kuwait", "الكويت", "ar-KW", "00003401", "965", "العربية (الكويت)"
    SetCountryData "LB", "Lebanon", "لبنان", "ar-LB", "00003001", "961", "العربية (لبنان)"
    SetCountryData "LY", "Libya", "ليبيا", "ar-LY", "00001001", "218", "العربية (ليبيا)"
    SetCountryData "MA", "Morocco", "المغرب", "ar-MA", "00001801", "212", "العربية (المغرب)"
    SetCountryData "MR", "Mauritania", "موريتانيا", "ar-MR", "00001801", "222", "العربية (موريتانيا)"
    SetCountryData "OM", "Oman", "عُمان", "ar-OM", "00002001", "968", "العربية (عُمان)"
    SetCountryData "PS", "Palestine", "فلسطين", "ar-PS", "00000401", "970", "العربية (فلسطين)"
    SetCountryData "QA", "Qatar", "قطر", "ar-QA", "00004001", "974", "العربية (قطر)"
    SetCountryData "SA", "Saudi Arabia", "المملكة العربية السعودية", "ar-SA", "00000401", "966", "العربية (السعودية)"
    SetCountryData "SD", "Sudan", "السودان", "ar-SD", "00002C01", "249", "العربية (السودان)"
    SetCountryData "SO", "Somalia", "الصومال", "ar-SO", "00000401", "252", "العربية (الصومال)"
    SetCountryData "SY", "Syria", "سوريا", "ar-SY", "00002801", "963", "العربية (سوريا)"
    SetCountryData "TN", "Tunisia", "تونس", "ar-TN", "00001C01", "216", "العربية (تونس)"
    SetCountryData "YE", "Yemen", "اليمن", "ar-YE", "00002401", "967", "العربية (اليمن)"
    
    ' البلدان الصينية
    SetCountryData "CN", "China", "الصين", "zh-CN", "00000804", "86", "الصينية (الصين)"
    SetCountryData "TW", "Taiwan", "تايوان", "zh-TW", "00000404", "886", "الصينية (تايوان)"
    SetCountryData "HK", "Hong Kong", "هونغ كونغ", "zh-HK", "00000C04", "852", "الصينية (هونغ كونغ)"
    SetCountryData "SG", "Singapore", "سنغافورة", "zh-SG", "00001004", "65", "الصينية (سنغافورة)"
    
    ' البلدان الإنجليزية
    SetCountryData "AU", "Australia", "أستراليا", "en-AU", "00000C09", "61", "الإنجليزية (أستراليا)"
    SetCountryData "CA", "Canada", "كندا", "en-CA", "00001009", "1", "الإنجليزية (كندا)"
    SetCountryData "GB", "UK", "المملكة المتحدة", "en-GB", "00000809", "44", "الإنجليزية (المملكة المتحدة)"
    SetCountryData "IE", "Ireland", "أيرلندا", "en-IE", "00001809", "353", "الإنجليزية (أيرلندا)"
    SetCountryData "IN", "India", "الهند", "en-IN", "00000409", "91", "الإنجليزية (الهند)"
    SetCountryData "NG", "Nigeria", "نيجيريا", "en-NG", "00000409", "234", "الإنجليزية (نيجيريا)"
    SetCountryData "NZ", "New Zealand", "نيوزيلندا", "en-NZ", "00001409", "64", "الإنجليزية (نيوزيلندا)"
    SetCountryData "PH", "Philippines", "الفلبين", "en-PH", "00000409", "63", "الإنجليزية (الفلبين)"
    SetCountryData "US", "USA", "الولايات المتحدة الأمريكية", "en-US", "00000409", "1", "الإنجليزية (الولايات المتحدة)"
    SetCountryData "ZA", "South Africa", "جنوب أفريقيا", "en-ZA", "00000409", "27", "الإنجليزية (جنوب أفريقيا)"
    
    ' البلدان الفرنسية
    SetCountryData "BE", "Belgium", "بلجيكا", "fr-BE", "0000080C", "32", "الفرنسية (بلجيكا)"
    SetCountryData "CA", "Canada", "كندا", "fr-CA", "00000C0C", "1", "الفرنسية (كندا)"
    SetCountryData "CH", "Switzerland", "سويسرا", "fr-CH", "0000100C", "41", "الفرنسية (سويسرا)"
    SetCountryData "FR", "France", "فرنسا", "fr-FR", "0000040C", "33", "الفرنسية (فرنسا)"
    SetCountryData "LU", "Luxembourg", "لوكسمبورغ", "fr-LU", "0000140C", "352", "الفرنسية (لوكسمبورغ)"
    SetCountryData "SN", "Senegal", "السنغال", "fr-SN", "0000040C", "221", "الفرنسية (السنغال)"
    
    ' البلدان الألمانية
    SetCountryData "AT", "Austria", "النمسا", "de-AT", "00000407", "43", "الألمانية (النمسا)"
    SetCountryData "CH", "Switzerland", "سويسرا", "de-CH", "00000807", "41", "الألمانية (سويسرا)"
    SetCountryData "DE", "Germany", "ألمانيا", "de-DE", "00000407", "49", "الألمانية (ألمانيا)"
    SetCountryData "LI", "Liechtenstein", "ليختنشتاين", "de-LI", "00001007", "423", "الألمانية (ليختنشتاين)"
    
    ' البلدان الهندية
    SetCountryData "IN", "India", "الهند", "hi-IN", "00000439", "91", "الهندية (الهند)"
    
    ' البلدان الإندونيسية
    SetCountryData "ID", "Indonesia", "إندونيسيا", "id-ID", "00000421", "62", "الإندونيسية (إندونيسيا)"
    
    ' البلدان الإيطالية
    SetCountryData "IT", "Italy", "إيطاليا", "it-IT", "00000410", "39", "الإيطالية (إيطاليا)"
    SetCountryData "SM", "San Marino", "سان مارينو", "it-SM", "00000410", "378", "الإيطالية (سان مارينو)"
    SetCountryData "VA", "Vatican City", "الفاتيكان", "it-VA", "00000410", "379", "الإيطالية (الفاتيكان)"
    
    ' البلدان اليابانية
    SetCountryData "JP", "Japan", "اليابان", "ja-JP", "00000411", "81", "اليابانية (اليابان)"
    
    ' البلدان الكورية
    SetCountryData "KR", "South Korea", "كوريا الجنوبية", "ko-KR", "00000412", "82", "الكورية (كوريا الجنوبية)"
    SetCountryData "KP", "North Korea", "كوريا الشمالية", "ko-KP", "00000412", "850", "الكورية (كوريا الشمالية)"
    
    ' البلدان البرتغالية
    SetCountryData "BR", "Brazil", "البرازيل", "pt-BR", "00000416", "55", "البرتغالية (البرازيل)"
    SetCountryData "PT", "Portugal", "البرتغال", "pt-PT", "00000816", "351", "البرتغالية (البرتغال)"
    SetCountryData "AO", "Angola", "أنغولا", "pt-AO", "00000416", "244", "البرتغالية (أنغولا)"
    SetCountryData "MZ", "Mozambique", "موزمبيق", "pt-MZ", "00000416", "258", "البرتغالية (موزمبيق)"
    
    ' البلدان الروسية
    SetCountryData "RU", "Russia", "روسيا", "ru-RU", "00000419", "7", "الروسية (روسيا)"
    SetCountryData "BY", "Belarus", "بيلاروسيا", "ru-BY", "00000419", "375", "الروسية (بيلاروسيا)"
    SetCountryData "KZ", "Kazakhstan", "كازاخستان", "ru-KZ", "00000419", "7", "الروسية (كازاخستان)"
    SetCountryData "KG", "Kyrgyzstan", "قيرغيزستان", "ru-KG", "00000419", "996", "الروسية (قيرغيزستان)"
    
    ' البلدان الإسبانية
    SetCountryData "AR", "Argentina", "الأرجنتين", "es-AR", "00002C0A", "54", "الإسبانية (الأرجنتين)"
    SetCountryData "BO", "Bolivia", "بوليفيا", "es-BO", "00002C0A", "591", "الإسبانية (بوليفيا)"
    SetCountryData "CL", "Chile", "تشيلي", "es-CL", "00002C0A", "56", "الإسبانية (تشيلي)"
    SetCountryData "CO", "Colombia", "كولومبيا", "es-CO", "00002C0A", "57", "الإسبانية (كولومبيا)"
    SetCountryData "CR", "Costa Rica", "كوستاريكا", "es-CR", "00002C0A", "506", "الإسبانية (كوستاريكا)"
    SetCountryData "CU", "Cuba", "كوبا", "es-CU", "00002C0A", "53", "الإسبانية (كوبا)"
    SetCountryData "DO", "Dominican Republic", "جمهورية الدومينيكان", "es-DO", "00002C0A", "1", "الإسبانية (جمهورية الدومينيكان)"
    SetCountryData "EC", "Ecuador", "الإكوادور", "es-EC", "00002C0A", "593", "الإسبانية (الإكوادور)"
    SetCountryData "ES", "Spain", "إسبانيا", "es-ES", "0000040A", "34", "الإسبانية (إسبانيا)"
    SetCountryData "GT", "Guatemala", "غواتيمالا", "es-GT", "00002C0A", "502", "الإسبانية (غواتيمالا)"
    SetCountryData "HN", "Honduras", "هندوراس", "es-HN", "00002C0A", "504", "الإسبانية (هندوراس)"
    SetCountryData "MX", "Mexico", "المكسيك", "es-MX", "0000080A", "52", "الإسبانية (المكسيك)"
    SetCountryData "NI", "Nicaragua", "نيكاراغوا", "es-NI", "00002C0A", "505", "الإسبانية (نيكاراغوا)"
    SetCountryData "PA", "Panama", "بنما", "es-PA", "00002C0A", "507", "الإسبانية (بنما)"
    SetCountryData "PE", "Peru", "بيرو", "es-PE", "00002C0A", "51", "الإسبانية (بيرو)"
    SetCountryData "PR", "Puerto Rico", "بورتوريكو", "es-PR", "00002C0A", "1", "الإسبانية (بورتوريكو)"
    SetCountryData "PY", "Paraguay", "باراغواي", "es-PY", "00002C0A", "595", "الإسبانية (باراغواي)"
    SetCountryData "SV", "El Salvador", "السلفادور", "es-SV", "00002C0A", "503", "الإسبانية (السلفادور)"
    SetCountryData "UY", "Uruguay", "أوروغواي", "es-UY", "00002C0A", "598", "الإسبانية (أوروغواي)"
    SetCountryData "VE", "Venezuela", "فنزويلا", "es-VE", "00002C0A", "58", "الإسبانية (فنزويلا)"
    
    ' البلدان التركية
    SetCountryData "TR", "Turkey", "تركيا", "tr-TR", "0000041F", "90", "التركية (تركيا)"
    SetCountryData "CY", "Cyprus", "قبرص", "tr-CY", "0000041F", "357", "التركية (قبرص)"

    ' التحقق من وجود عنصر cmbLanguage في النموذج
    If Not Me.cmbLanguage Is Nothing Then
        ' مسح العناصر القديمة من مربع السرد
        Me.cmbLanguage = ""

        ' ملء مربع السرد بأسماء البلدان الكاملة من المصفوفة
        Dim i As Integer
        For i = 1 To UBound(countries)
            Me.cmbLanguage.AddItem countries(i).nativeLanguage
        Next i
    Else
        ' إظهار رسالة خطأ إذا لم يتم العثور على مربع السرد
        MsgBox "لا يمكن العثور على مربع السرد 'cmbLanguage'.", vbCritical
    End If

    ' الخروج من الإجراء دون تنفيذ كود معالج الأخطاء
    Exit Sub

ErrorHandler:
    ' تسجيل الخطأ في ملف السجل باستخدام الدالة LogError
    LogError "حدث خطأ في LoadCountries: " & Err.Description

    ' إظهار رسالة خطأ للمستخدم
    MsgBox "حدث خطأ أثناء تحميل البلدان", vbCritical
End Sub

Private Sub Form_Load()
    ' تحميل أسماء البلدان إلى مربع السرد
    LoadCountries

    ' تعيين اللغة الافتراضية (مصر) في مربع السرد
    cmbLanguage.Value = "العربية (مصر)"

    ' تعيين تفاصيل البلد الافتراضي (مصر)
    countrySettings = GetArabicCountrySettings("EG")

    ' عرض اسم البلد في مربع النص
    txtConteryName.Value = GetNonUnicodeLanguage()
End Sub

Private Sub cmbLanguage_Change()
    ' معالجة الأخطاء: في حالة حدوث خطأ، يتم الانتقال إلى ErrorHandler
    On Error GoTo ErrorHandler

    ' الحصول على اسم البلد المختار من مربع السرد
    Dim selectedCountryName As String
    selectedCountryName = Me.cmbLanguage.Value

    ' البحث عن البلد المختار في المصفوفة
    Dim i As Integer
    For i = 1 To UBound(countries)
        If countries(i).nativeLanguage = selectedCountryName Then
            ' إذا تم العثور على البلد، يتم حفظ تفاصيله
            countrySettings = countries(i)
            Exit For
        End If
    Next i

    ' إظهار رسالة بناءً على نتيجة البحث
    If i <= UBound(countries) Then
        MsgBox "تم تحديد اللغة: " & selectedCountryName, vbInformation, "لغة مختارة"
    Else
        MsgBox "لم يتم العثور على اللغة في القائمة.", vbExclamation, "خطأ"
    End If

    ' الخروج من الإجراء دون تنفيذ كود معالج الأخطاء
    Exit Sub

ErrorHandler:
    ' إظهار رسالة خطأ في حالة حدوث مشكلة
    MsgBox "حدث خطأ أثناء تحديد اللغة.", vbCritical, "خطأ"
End Sub

Private Sub btnLanguage_Click()
    ' معالجة الأخطاء: في حالة حدوث خطأ، يتم الانتقال إلى ErrorHandler
    On Error GoTo ErrorHandler

    ' التحقق مما إذا تم اختيار لغة من القائمة
    If countrySettings.countryCode = "" Then
        MsgBox "يرجى اختيار لغة من القائمة.", vbExclamation, "اختيار اللغة"
        Exit Sub
    End If

    ' تنفيذ تغيير اللغة مع تأخير 15 ثانية قبل إعادة التشغيل
    Call ChangeSystemLanguage(15)

    ' إعلام المستخدم بأن تغيير اللغة سيتم وإعادة التشغيل قريبًا
    MsgBox "تم تحديد اللغة بنجاح، سيتم إعادة تشغيل النظام في غضون 15 ثانية.", vbInformation, "تغيير اللغة"

    ' الخروج من الإجراء دون تنفيذ كود معالج الأخطاء
    Exit Sub

ErrorHandler:
    ' إظهار رسالة خطأ في حالة حدوث مشكلة
    MsgBox "حدث خطأ أثناء محاولة تغيير اللغة.", vbCritical, "خطأ"
End Sub

Private Function GetRegistryValue(ByVal keyPath As String, ByVal valueName As String) As String
    
#If VBA7 Then
    ' إصدار 64 بت
    Dim hKey As LongPtr
#Else
    ' إصدار 32 بت
    Dim hKey As Long
#End If
    
    Dim ret As Long
    Dim valueType As Long
    Dim valueData As String
    Dim dataLength As Long
    
    ' فتح المفتاح
    ret = RegOpenKeyEx(HKEY_LOCAL_MACHINE, keyPath, 0, KEY_QUERY_VALUE Or KEY_WOW64_64KEY, hKey)
    
    If ret = 0 Then
        ' تحديد حجم البيانات
        ret = RegQueryValueEx(hKey, valueName, 0, valueType, vbNullString, dataLength)
        
        If ret = 0 And valueType = REG_SZ Then
            ' قراءة البيانات
            valueData = String(dataLength, Chr(0))
            ret = RegQueryValueEx(hKey, valueName, 0, valueType, valueData, dataLength)
            
            If ret = 0 Then
                ' إزالة الأحرف الفارغة من النهاية
                GetRegistryValue = Left(valueData, dataLength - 1)
            End If
        End If
        
        ' إغلاق المفتاح
        RegCloseKey (hKey)
    End If
End Function

Private Function GetNonUnicodeLanguage() As String
    Dim localeID As String
    ' قراءة قيمة السجل
    localeID = GetRegistryValue("SYSTEM\CurrentControlSet\Control\Nls\Language", "Default")
    
    ' تحويل القيمة إلى Long
    Dim localeIDLong As Long
    localeIDLong = Val("&H" & localeID)
    
    ' استخدام Locale ID لتحديد اللغة
    Select Case localeIDLong
        ' البلدان العربية
        Case &H401: GetNonUnicodeLanguage = "العربية (السعودية)"
        Case &H801: GetNonUnicodeLanguage = "العربية (العراق)"
        Case &HC01: GetNonUnicodeLanguage = "العربية (مصر)"
        Case &H1001: GetNonUnicodeLanguage = "العربية (ليبيا)"
        Case &H1401: GetNonUnicodeLanguage = "العربية (الجزائر)"
        Case &H1801: GetNonUnicodeLanguage = "العربية (المغرب)"
        Case &H1C01: GetNonUnicodeLanguage = "العربية (تونس)"
        Case &H2001: GetNonUnicodeLanguage = "العربية (عُمان)"
        Case &H2401: GetNonUnicodeLanguage = "العربية (اليمن)"
        Case &H2801: GetNonUnicodeLanguage = "العربية (سوريا)"
        Case &H2C01: GetNonUnicodeLanguage = "العربية (الأردن)"
        Case &H3001: GetNonUnicodeLanguage = "العربية (لبنان)"
        Case &H3401: GetNonUnicodeLanguage = "العربية (الكويت)"
        Case &H3801: GetNonUnicodeLanguage = "العربية (الإمارات)"
        Case &H3C01: GetNonUnicodeLanguage = "العربية (البحرين)"
        Case &H4001: GetNonUnicodeLanguage = "العربية (قطر)"
        
        ' البلدان الإنجليزية
        Case &H409: GetNonUnicodeLanguage = "الإنجليزية (الولايات المتحدة)"
        Case &H809: GetNonUnicodeLanguage = "الإنجليزية (المملكة المتحدة)"
        Case &HC09: GetNonUnicodeLanguage = "الإنجليزية (أستراليا)"
        Case &H1009: GetNonUnicodeLanguage = "الإنجليزية (كندا)"
        Case &H1409: GetNonUnicodeLanguage = "الإنجليزية (نيوزيلندا)"
        Case &H1809: GetNonUnicodeLanguage = "الإنجليزية (أيرلندا)"
        Case &H1C09: GetNonUnicodeLanguage = "الإنجليزية (جنوب أفريقيا)"
        Case &H2009: GetNonUnicodeLanguage = "الإنجليزية (جامايكا)"
        Case &H2409: GetNonUnicodeLanguage = "الإنجليزية (الكاريبي)"
        Case &H2809: GetNonUnicodeLanguage = "الإنجليزية (بليز)"
        Case &H2C09: GetNonUnicodeLanguage = "الإنجليزية (ترينيداد)"
        Case &H3009: GetNonUnicodeLanguage = "الإنجليزية (زيمبابوي)"
        Case &H3409: GetNonUnicodeLanguage = "الإنجليزية (الفلبين)"
        Case &H3809: GetNonUnicodeLanguage = "الإنجليزية (الهند)"
        
        ' البلدان الفرنسية
        Case &H40C: GetNonUnicodeLanguage = "الفرنسية (فرنسا)"
        Case &H80C: GetNonUnicodeLanguage = "الفرنسية (بلجيكا)"
        Case &HC0C: GetNonUnicodeLanguage = "الفرنسية (كندا)"
        Case &H100C: GetNonUnicodeLanguage = "الفرنسية (سويسرا)"
        Case &H140C: GetNonUnicodeLanguage = "الفرنسية (لوكسمبورغ)"
        Case &H180C: GetNonUnicodeLanguage = "الفرنسية (موناكو)"
        Case &H1C0C: GetNonUnicodeLanguage = "الفرنسية (السنغال)"
        
        ' البلدان الألمانية
        Case &H407: GetNonUnicodeLanguage = "الألمانية (ألمانيا)"
        Case &H807: GetNonUnicodeLanguage = "الألمانية (سويسرا)"
        Case &HC07: GetNonUnicodeLanguage = "الألمانية (النمسا)"
        Case &H1007: GetNonUnicodeLanguage = "الألمانية (ليختنشتاين)"
        
        ' البلدان الهندية
        Case &H439: GetNonUnicodeLanguage = "الهندية (الهند)"
        
        ' البلدان الإندونيسية
        Case &H421: GetNonUnicodeLanguage = "الإندونيسية (إندونيسيا)"
        
        ' البلدان الإيطالية
        Case &H410: GetNonUnicodeLanguage = "الإيطالية (إيطاليا)"
        Case &H810: GetNonUnicodeLanguage = "الإيطالية (سويسرا)"
        Case &HC10: GetNonUnicodeLanguage = "الإيطالية (سان مارينو)"
        Case &H1010: GetNonUnicodeLanguage = "الإيطالية (الفاتيكان)"
        
        ' البلدان اليابانية
        Case &H411: GetNonUnicodeLanguage = "اليابانية (اليابان)"
        
        ' البلدان الكورية
        Case &H412: GetNonUnicodeLanguage = "الكورية (كوريا الجنوبية)"
        Case &H812: GetNonUnicodeLanguage = "الكورية (كوريا الشمالية)"
        
        ' البلدان البرتغالية
        Case &H416: GetNonUnicodeLanguage = "البرتغالية (البرازيل)"
        Case &H816: GetNonUnicodeLanguage = "البرتغالية (البرتغال)"
        Case &HC16: GetNonUnicodeLanguage = "البرتغالية (أنغولا)"
        Case &H1016: GetNonUnicodeLanguage = "البرتغالية (موزمبيق)"
        
        ' البلدان الروسية
        Case &H419: GetNonUnicodeLanguage = "الروسية (روسيا)"
        Case &H819: GetNonUnicodeLanguage = "الروسية (بيلاروسيا)"
        Case &HC19: GetNonUnicodeLanguage = "الروسية (كازاخستان)"
        Case &H1019: GetNonUnicodeLanguage = "الروسية (قيرغيزستان)"
        
        ' البلدان الإسبانية
        Case &H40A: GetNonUnicodeLanguage = "الإسبانية (إسبانيا)"
        Case &H80A: GetNonUnicodeLanguage = "الإسبانية (المكسيك)"
        Case &HC0A: GetNonUnicodeLanguage = "الإسبانية (الأرجنتين)"
        Case &H100A: GetNonUnicodeLanguage = "الإسبانية (كولومبيا)"
        Case &H140A: GetNonUnicodeLanguage = "الإسبانية (بيرو)"
        Case &H180A: GetNonUnicodeLanguage = "الإسبانية (فنزويلا)"
        Case &H1C0A: GetNonUnicodeLanguage = "الإسبانية (تشيلي)"
        Case &H200A: GetNonUnicodeLanguage = "الإسبانية (الإكوادور)"
        Case &H240A: GetNonUnicodeLanguage = "الإسبانية (غواتيمالا)"
        Case &H280A: GetNonUnicodeLanguage = "الإسبانية (كوبا)"
        Case &H2C0A: GetNonUnicodeLanguage = "الإسبانية (بوليفيا)"
        Case &H300A: GetNonUnicodeLanguage = "الإسبانية (جمهورية الدومينيكان)"
        Case &H340A: GetNonUnicodeLanguage = "الإسبانية (بورتوريكو)"
        Case &H380A: GetNonUnicodeLanguage = "الإسبانية (أوروغواي)"
        Case &H3C0A: GetNonUnicodeLanguage = "الإسبانية (باراغواي)"
        Case &H400A: GetNonUnicodeLanguage = "الإسبانية (كوستاريكا)"
        Case &H440A: GetNonUnicodeLanguage = "الإسبانية (السلفادور)"
        Case &H480A: GetNonUnicodeLanguage = "الإسبانية (هندوراس)"
        Case &H4C0A: GetNonUnicodeLanguage = "الإسبانية (نيكاراغوا)"
        Case &H500A: GetNonUnicodeLanguage = "الإسبانية (بنما)"
        
        ' البلدان التركية
        Case &H41F: GetNonUnicodeLanguage = "التركية (تركيا)"
        Case &H81F: GetNonUnicodeLanguage = "التركية (قبرص)"
        
        ' الحالة الافتراضية
        Case Else: GetNonUnicodeLanguage = "غير معروف (Locale ID: " & localeID & ")"
    End Select
End Function

بس خلاص واترككم فى حفظ الله ورعايته واتمنى لكم تجربة ممتعه شيقة مع المرفق الذى يحتوى على نموذجين 

طبعا لم اهتم كثيرا بالتفاصيل والرسائل بقدر اهتمامى باليه العمل 

الاول بالعربى لمن يريد  ,  والثانى بالانجليزية لمن يريد 

فى انتظار أرائكم يا سادة 

 

ChangeLanguage V 1.0.zip

  • Like 2
قام بنشر (معدل)

يا اهلا وسهلاً بالإبداعات ..

جميل جداً جداً... 🙏

أنا قلتلك إني هفرمت الكمبيوتر وأنزل ويندوز تانية ، ومش هعتمد على استعادة النظام خالص ، وجربت المرفق 😁 ..

أول حاجة أنا كنت بالغنى عنها إني أضيف كل اللغات العالمية .. بالنسبة لي دي انا كنت مش بحاجتها لإن هدفي كان الناس اللي عندنا في الوطن العربي بس ..

تاني حاجة وهي دي المهمة ، انا ما عرفتش اختار في النموذج العربي اللغة اللي انا عايزها بشكل نهائي ، بص

Error01.png.cc8390072b6d029c02f1c0cd197084c6.png

 

وتالت حاجة دي محتاجة إعادة تركيز اعتقد عندي وعندك . وهي إن لغة الترميز أو اللغة الإدارية Current System Local ما تغيرتش رغم اني اخترت دولة عشوائية وطلعت البحرين 😇 .

وحاجة تانية سريعة كده ، هي ملف الباتش اللي بيظهر على سطح المكتب 🤔

 

الحاجات التانية بعد ما اركز شوية 😁 هبقى أقولك عليها ، بس انت اصبر شوية 😈

تم تعديل بواسطه Foksh
قام بنشر
7 دقائق مضت, Foksh said:

أول حاجة أنا كنت بالغنى عنها إني أضيف كل اللغات العالمية .. بالنسبة لي دي انا كنت مش بحاجتها لإن هدفي كان الناس اللي عندنا في الوطن العربي بس ..

ممكن ازالتها من الكود ولكن انا قلت احاول اقدم الكود باكبر قدر ممكن من الشموليه :yes:

8 دقائق مضت, Foksh said:

تاني حاجة وهي دي المهمة ، انا ما عرفتش اختار في النموذج العربي اللغة اللي انا عايزها بشكل نهائي ، بص

ولذلك انا عملت النموذجين العربى والانجليزى 

9 دقائق مضت, Foksh said:

وتالت حاجة دي محتاجة إعادة تركيز اعتقد عندي وعندك . وهي إن لغة الترميز أو اللغة الإدارية Current System Local ما تغيرتش رغم اني اخترت دولة عشوائية وطلعت البحرين 😇 .

انا عندى شغاله اهون وانا اخترت البحرين من نموذج الاكسس ودى النتيجة بعد الريستارت

خلينى اغير الدوله وارجع لك تانى بعد الريستارت

10 دقائق مضت, Foksh said:

الحاجات التانية بعد ما اركز شوية 😁 هبقى أقولك عليها ، بس انت اصبر شوية 😈

ههههههه طيب وشكرا ليك بجد ع الفكرة 

 

0.JPG

قام بنشر
55 دقائق مضت, ابو جودي said:

ولذلك انا عملت النموذجين العربى والانجليزى

يبقى قدامك حل من اتنين ،، يا إما تغير اسماء الدول واللغات في النموذج العربي ، أو إنها كفكرة وبما إن الهدف اللغة العربية!! تقدر تخلي قيمة الليست بوكس مضمنة داخل مصدر صف الليست بوكس نفسه وليس من خلال الكود ، اعتقد بكدة تكون حليت مشكلة القيم العربية بدل ما تاخدها من حدث عند التحميل وتكتبهم داخل الـ VBA . ودي انا كنت عاملها في التحديث الجديد 😉 .

قام بنشر

Error01.png.cc8390072b6d029c02f1c0cd197084c6.png.586912a58862dc121a28f56a8c798aad.png

 

ع العموم للتخلص نهائيا من هذه المشاكل 

قمت ببعض التعديلات تم عمل التالى 

ترتيب اللغات داخل مربع السرد مع ضمان ظهرها باللغة العربية بشكل صحيح بدون مشاكل الترميز و طبقا لترتيب ويندوز 

الابقاء فقط على اللغات العربيىة طبقا لرغبتك

اذا المرفق الاول يجمع كل الافكار وكل الاكواد ليكون مرجعا شاملا 
اما هذا المرفق الاخيـر يختص بحل المشكلة الخاصة بالترميز ودعم اللغة العربية على وجه الخصوص 

 

arabic for non unicode programs.accdb

  • Thanks 1

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.

زائر
اضف رد علي هذا الموضوع....

×   Pasted as rich text.   Paste as plain text instead

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

×
×
  • اضف...

Important Information