البحث في الموقع

السلام عليكم ورحمة الله تعالى وبركاته بعد مرورى على موضوع استاذى الجليل واخى الحبيب الاستاذ @Foksh والموضوع هو فى هذه >---->> المشاركة من هنا طلبت منه العب شويه بعد الاطلاع والتجربه على افكاره النيره وتطبيقه الاكثر من رائع وبجد الاول فى عرض فكرته تقريبا ولكن لن يكون الأخير فنحن هنا وحتما ولابد أن نضع بصمتنا زعق لى وقالى اجرى العب بعيد ياض من هنا لحسن ارش ميه 😡 قلت اجى العب هنا لحالى ولوحدى - وظيفة المرفق هى : ضبط وتعديل اللغة المستخدمة في البرامج غير الموحدة ( 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