نجوم المشاركات

ما اقصده اخي انك اخترت إجابتك كأفضل إجابة ، وليس إجابة الأستاذ @ابو عارف التي وجدت بها الحل . كل الشكر والتقدير لشخصك الكريم 🤗 وتقبل الله منكم الصيام 🤲🏻

تفضل حبيبي Full Control Of Print Report.mdb

طيب ممكن مشاركة اثراء للموضوع يا استاذ @Foksh ايه رايك طالما كده كده هنعمل اكواد داخل موديول نتوسع فى الافكار ونشطح بخيالنا حبتين علشان يكون قفلنا كل المشاكل الممكن حدوثها شوف يا سيدى انا اقصد بالمشاكل مثلا عندك شهر ابريل ممكن يكون أبريل وشهر يونيه ممكن يكون يونيو ده على سبيل المثال وليس الحصر خلينا بقه نستخدم القواميس الممتعه فى شغلها ونكتب الداله من خلالها بالشكل ده Option Compare Database Option Explicit ' تهيئة القواميس مرة واحدة فقط لتوفير الأداء Dim monthsDict As Object Dim daysDict As Object ' دالة لإنشاء قاموس ديناميكيًا Public Function CreateDictionary() As Object Set CreateDictionary = CreateObject("Scripting.Dictionary") End Function ' تهيئة القواميس عند بدء التشغيل Sub InitializeDictionaries() If monthsDict Is Nothing Then Set monthsDict = InitializeMonthsDictionary() If daysDict Is Nothing Then Set daysDict = InitializeDaysDictionary() End Sub Function GetDaysInfo(monthInput As Variant, Optional yearValue As Variant = -1, Optional targetDay As Variant = "MonthDays") As Variant Dim MonthNumber As Long Dim firstDay As Date Dim totalDays As Long Dim daysArray(1 To 7) As Long Dim currentDate As Date Dim result As Variant Dim i As Long ' تهيئة القواميس مرة واحدة InitializeDictionaries '--- تعديل رئيسي: التحقق من السنة --- If IsMissing(yearValue) Or yearValue = -1 Then yearValue = Year(Date) ' استخدام السنة الحالية إذا لم تُحدد Else ' التأكد من أن yearValue هو رقم صحيح If Not IsNumeric(yearValue) Then GetDaysInfo = "خطأ: السنة يجب أن تكون رقمًا" Exit Function End If yearValue = CLng(yearValue) End If ' تعيين السنة الحالية إذا لم تُمرر If yearValue = 0 Then yearValue = Year(Date) ' معالجة إدخال الشهر If IsNumeric(monthInput) Then MonthNumber = CLng(monthInput) Else MonthNumber = GetNumberFromDict(monthsDict, monthInput) End If If MonthNumber < 1 Or MonthNumber > 12 Then GetDaysInfo = "خطأ في الشهر: " & monthInput & vbCrLf & "الأشهر المتاحة: " & Join(monthsDict.Keys, ", ") Exit Function End If ' حساب أيام الشهر totalDays = Day(DateSerial(yearValue, MonthNumber + 1, 0)) firstDay = DateSerial(yearValue, MonthNumber, 1) ' تهيئة المصفوفة For i = 1 To 7 daysArray(i) = 0 Next i ' حساب أيام الأسبوع (الأحد = 1) For i = 0 To totalDays - 1 currentDate = firstDay + i daysArray(Weekday(currentDate, vbSunday)) = daysArray(Weekday(currentDate, vbSunday)) + 1 Next i ' معالجة طلب اليوم المستهدف Select Case True Case targetDay = "MonthDays" Or targetDay = "أيام_الشهر" result = totalDays Case targetDay = "ALL" Or targetDay = "الكل" result = daysArray Case Else Dim dayCode As Long dayCode = GetNumberFromDict(daysDict, targetDay) If dayCode = 0 Then GetDaysInfo = "خطأ في اليوم: " & targetDay & vbCrLf & "الأيام المتاحة: " & Join(daysDict.Keys, ", ") Exit Function End If result = daysArray(dayCode) End Select GetDaysInfo = result End Function Function InitializeMonthsDictionary() As Object Dim dict As Object Set dict = CreateDictionary() With dict ' شهر 1 .Add "1", 1 .Add "jan", 1 .Add "january", 1 .Add "يناير", 1 .Add "ينا", 1 .Add "ين", 1 ' شهر 2 .Add "2", 2 .Add "feb", 2 .Add "february", 2 .Add "فبراير", 2 .Add "فبر", 2 .Add "فب", 2 ' شهر 3 .Add "3", 3 .Add "mar", 3 .Add "march", 3 .Add "مارس", 3 .Add "ماس", 3 .Add "ما", 3 ' شهر 4 .Add "4", 4 .Add "apr", 4 .Add "april", 4 .Add "أبريل", 4 .Add "إبريل", 4 .Add "ابريل", 4 .Add "ابر", 4 ' شهر 5 .Add "5", 5 .Add "may", 5 .Add "مايو", 5 .Add "ماي", 5 ' شهر 6 .Add "6", 6 .Add "jun", 6 .Add "june", 6 .Add "يونية", 6 .Add "يونيه", 6 .Add "يونيو", 6 .Add "يون", 6 ' شهر 7 .Add "7", 7 .Add "jul", 7 .Add "july", 7 .Add "يوليو", 7 .Add "يوليه", 7 .Add "يولية", 7 .Add "يول", 7 ' شهر 8 .Add "8", 8 .Add "aug", 8 .Add "august", 8 .Add "أغسطس", 8 .Add "اغسطس", 8 .Add "أغس", 8 ' شهر 9 .Add "9", 9 .Add "sep", 9 .Add "september", 9 .Add "سبتمبر", 9 .Add "سبت", 9 ' شهر 10 .Add "10", 10 .Add "oct", 10 .Add "october", 10 .Add "أكتوبر", 10 .Add "اكتوبر", 10 .Add "أكت", 10 ' شهر 11 .Add "11", 11 .Add "nov", 11 .Add "november", 11 .Add "نوفمبر", 11 .Add "نوف", 11 ' شهر 12 .Add "12", 12 .Add "dec", 12 .Add "december", 12 .Add "ديسمبر", 12 .Add "ديس", 12 End With Set InitializeMonthsDictionary = dict End Function Function InitializeDaysDictionary() As Object Dim dict As Object Set dict = CreateDictionary() With dict ' الأحد .Add "1", 1 .Add "sun", 1 .Add "sunday", 1 .Add "الأحد", 1 .Add "الاحد", 1 .Add "أحد", 1 .Add "احد", 1 .Add "ح", 1 ' الإثنين .Add "2", 2 .Add "mon", 2 .Add "monday", 2 .Add "الإثنين", 2 .Add "الاثنين", 2 .Add "إثنين", 2 .Add "اثنين", 2 .Add "ن", 2 ' الثلاثاء .Add "3", 3 .Add "tue", 3 .Add "tuesday", 3 .Add "الثلاثاء", 3 .Add "ثلاثاء", 3 .Add "ث", 3 ' الأربعاء .Add "4", 4 .Add "wed", 4 .Add "wednesday", 4 .Add "الأربعاء", 4 .Add "الاربعاء", 4 .Add "أربعاء", 4 .Add "ر", 4 ' الخميس .Add "5", 5 .Add "thu", 5 .Add "thursday", 5 .Add "الخميس", 5 .Add "خميس", 5 .Add "خ", 5 ' الجمعة .Add "6", 6 .Add "fri", 6 .Add "friday", 6 .Add "الجمعة", 6 .Add "الجمعه", 6 .Add "جمعة", 6 .Add "جم", 6 .Add "ج", 6 ' السبت .Add "7", 7 .Add "sat", 7 .Add "saturday", 7 .Add "السبت", 7 .Add "سبت", 7 .Add "س", 7 End With Set InitializeDaysDictionary = dict End Function Function GetNumberFromDict(dict As Object, key As Variant) As Long key = LCase(Trim(CStr(key))) If dict.Exists(key) Then GetNumberFromDict = dict(key) Else GetNumberFromDict = 0 End If End Function ودى كل نتائج الكود من خلال استعلام SELECT shr, GetDaysInfo([shr], 0, "MonthDays") AS عدد_أيام_الشهر, GetDaysInfo([shr], 0, "Sunday") AS عدد_أيام_الأحد, GetDaysInfo([shr], 0, "Monday") AS عدد_أيام_الاثنين, GetDaysInfo([shr], 0, "Tuesday") AS عدد_أيام_الثلاثاء, GetDaysInfo([shr], 0, "Wednesday") AS عدد_أيام_الأربعاء, GetDaysInfo([shr], 0, "Thursday") AS عدد_أيام_الخميس, GetDaysInfo([shr], 0, "ج") AS عدد_أيام_الجمعة, GetDaysInfo([shr], 0, "السبت") AS عدد_أيام_السبت FROM data_shr; المميزات فى الكود دعم كامل للغات: يقبل المدخلات بالعربية والإنجليزية (كاملة ومختصرة) كفاءة عالية: تهيئة القواميس مرة واحدة فقط مرونة استثنائية: يقبل حتى الاختصارات غير التقليدية واقصد بذلك الأشهر: إضافة اختصارات مثل "ينا" (يناير), "فبر" (فبراير), "ابر" (أبريل), "ديس" (ديسمبر) الأيام: إضافة اختصارات مثل "ح" (الأحد), "ن" (الإثنين), "جم" (الجمعة) توثيق ذاتي: يعرض جميع الخيارات المتاحة عند حدوث خطأ شئ مهم كمان: ثبات النتائج: تم تثبيت بداية الأسبوع على يوم الأحد باستخدام Weekday(currentDate, vbSunday) لتجنب تأثير إعدادات النظام و لحساب الأيام بشكل دقيق تقدر تجرب من خلال الاستعلام ده شوف فى الاستدعاء الطرق المختلفة لشهر اكتوبر وليوم الاحد والتى تظهر المرونة المطلقة فى الاستدعاء SELECT shr, GetDaysInfo(10,0,"MonthDays") AS عدد_أيام_الشهر, GetDaysInfo("اكتوبر", 0, "ح") AS 2عدد_أيام_الأحد, GetDaysInfo("اكتوبر", 0, "أحد") AS 3عدد_أيام_الأحد, GetDaysInfo("اكتوبر", 0, "sun") AS 4عدد_أيام_الأحد, GetDaysInfo(10, 0, 1) AS 5عدد_أيام_الأحد FROM data_shr;

هذا ما فعلته أخى لأنه فى بداية المشاركة لم يكن يجيب سوى الأخ العزيز أبو عارف .. والسؤال الآن موجه لك : ماذا تقصد بالضبط !!!!

وعليكم السلام مش مهم هو لمين علشان كان واحد غلس المهم جرب المرفق ده وفيه اضافات جديده Full Control Of Print Report التحكم في الطابعة وخصائصها طباعة التقارير.mdb

وعليكم السلام ورحمة الله وبركاته .. من خلال تصميمك للجدول ، نستطيع انشاء دالة عامة في مديول كالتالي - بناءً على أسماء الأشهر لديك :- Function CalculateFridaysSaturdays(monthName As String, year As Integer, Optional dayType As String = "Both") As Variant Dim monthNumber As Integer Dim startDate As Date Dim endDate As Date Dim currentDate As Date Dim fridays As Integer Dim saturdays As Integer Select Case monthName Case "يناير" monthNumber = 1 Case "فبراير" monthNumber = 2 Case "مارس" monthNumber = 3 Case "ابريل" monthNumber = 4 Case "مايو" monthNumber = 5 Case "يونيو" monthNumber = 6 Case "يوليو" monthNumber = 7 Case "اغسطس" monthNumber = 8 Case "سبتمبر" monthNumber = 9 Case "اكتوبر" monthNumber = 10 Case "نوفمبر" monthNumber = 11 Case "ديسمبر" monthNumber = 12 Case Else CalculateFridaysSaturdays = "اسم الشهر غير صحيح" Exit Function End Select startDate = DateSerial(year, monthNumber, 1) endDate = DateSerial(year, monthNumber + 1, 0) fridays = 0 saturdays = 0 currentDate = startDate Do While currentDate <= endDate If Weekday(currentDate) = vbFriday Then fridays = fridays + 1 ElseIf Weekday(currentDate) = vbSaturday Then saturdays = saturdays + 1 End If currentDate = currentDate + 1 Loop If dayType = "Friday" Then CalculateFridaysSaturdays = fridays ElseIf dayType = "Saturday" Then CalculateFridaysSaturdays = saturdays Else CalculateFridaysSaturdays = Array(fridays, saturdays) End If End Function ومن خلال استعلام تحديث ، تستطيع استدعاء الدالة لتحديث القيم في الحقلين حسب السنة الحالية كالآتي :- UPDATE data_shr SET gm = CalculateFridaysSaturdays([shr], Year(Date()), "Friday"), sbt = CalculateFridaysSaturdays([shr], Year(Date()), "Saturday"); النتيجة ، افتح استعلام التحديث Query2 وشوف النتيجة في المرفق التالي :- ايام الغياب.accdb

وعليكم السلام ورحمة الله وبركاته .. جرب هذا التعديل بالاستعلام التالي :- SELECT D.Cood, IIf([D].[Percent]*100 <= 60 Or [S].[natio] = 'S', "خارج", [S].[Tans]) AS Expr1 FROM S INNER JOIN D ON S.Cood = D.Cood; جرب الاستعلام وأخبرني بالنتيجة !! 😊

وعليكم السلام ورحمة الله تعالى وبركاته بالنسبة للكود المقدم لك مسبقا يمكنك تعديله على الشكل التالي Private Sub CommandButton16_Click() Dim Tmam_Wbk As Workbook, TPath As String If ComboBox28.Value = "" Then MsgBox "من فضلك أختار التجهيزة": Exit Sub If OptionButton1.Value Then TPath = ThisWorkbook.Path & "\تمام\مدينة\" & ComboBox28.Value ElseIf OptionButton2.Value Then TPath = ThisWorkbook.Path & "\تمام\محافظات\" & ComboBox28.Value End If If Len(Dir(TPath & ".xlsx")) > 0 Then TPath = TPath & ".xlsx" ElseIf Len(Dir(TPath & ".xls")) > 0 Then TPath = TPath & ".xls" Else MsgBox "الملف غير موجود": Exit Sub End If On Error GoTo ErrorHandler Set Tmam_Wbk = Workbooks.Open(TPath) Unload Me Exit Sub ErrorHandler: Unload Me End Sub هنا قمت بتعديل الامتدادات على عدة أكواد للتجربة Run V3.xls

وعليكم السلام تفضل Full Control Of Print Report.mdb

السلام عليكم ورحمة الله وبركاته استاذي / Foksh تم على الوجه الاكمل كل الشكر والتقدير دمت بحفظ الله

نسيت اشرح ما تم عمله .. قد تكون عرفته من غير شرح مني .. ولكن التوضيح لمن يمر من هنا ويريد ان يفهم الحسابات .. الاستاذ / الرئيسي / الفرعي / التحليلي .. كلها ضمن حقل او عمود واحد .. وهو عبارة عن رقم 8 خانات مقسمة حسب هذا التفريع خانتين خانتين الاستاذ اول رقمين ثم الرقمين التاليين تخص الرئيسي ... وهكذا فانا جعلت معيار الرئيسي هو الرقمين الأولين ، ومعيار الفرعي هي اول اربعة ارقام ، ومعيار التحليلي هي اول ستة ارقام

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

قد يكون الحقل في الجدول نصي وليس رقمي,, جرب التعديل التالي :- Private Sub txt_AfterUpdate() Dim selectedYear As Integer selectedYear = Me.txt Me.Filter = "[TOTALSHY] = 0 OR ([yearshy] <> '" & selectedYear & "' AND [TOTALSHY] <> 0)" Me.FilterOn = True End Sub

Private Sub Form_Open(Cancel As Integer) Dim i As Boolean i = Nz(DLookup("Name_ID", "Name_Tbl", "Name_ID=" & crMyfrmId), 0) If i = True Then DoCmd.GoToRecord , , , crMyfrmId Else DoCmd.GoToRecord , , acNewRec End If End Sub crMyfrmId هو متغير عام يحمل رقم السجل Tracking test to المنتدى.rar

بسيطة ان شاء الله ، حاليا انا بعيد من كمبيوتر

السلام عليكم : دعائنا في هذا الشهر الفضيل لك ولولديك بالتوفيق والمغفرة وجزاكم الله خيرا في الدنيا والاخرة. نعم النتيجة مبهرة بعد تعديل جنابكم الكريم ... بارك الله بجهودكم القيمة وشكراً جزيلاً

السلام عليكم ... داخل الكود هل يتم كتابة جميع الجداول و الإستعلامات و النماذج و التقارير قاعدة البانات: DoCmd.Close acForm, "اسم_النموذج", acSaveYes DoCmd.Close acReport, "اسم_التقرير", acSaveYes DoCmd.Close acTable, "اسم_الجدول", acSaveYes DoCmd.Close acQuery, "اسم_الاستعلام", acSaveYes

التعديل الصحيح بنظري هو الآتي بإضافة دالة للتعامل مع "أ" أو "إ" أو "ا" أو "ه" أو "ة" :- Private Function NormalizeArabicText(text As String) As String Dim result As String result = text result = Replace(result, "أ", "ا") result = Replace(result, "إ", "ا") result = Replace(result, "آ", "ا") result = Replace(result, "ة", "ه") NormalizeArabicText = result End Function Private Function GetLastName(nameArray() As String) As String If UBound(nameArray) >= 0 Then GetLastName = nameArray(UBound(nameArray)) Else GetLastName = "" End If End Function Private Sub NameEmployee_AfterUpdate() Dim db As DAO.Database Dim rs As DAO.Recordset Dim strEmpName As String Dim arrName() As String Dim lastName As String Dim relation As String Dim empID As Integer Dim found As Boolean Dim isFemaleName As Boolean Dim i As Integer Const MIN_MATCHING_NAMES = 2 Set db = CurrentDb() strEmpName = Me.NameEmployee arrName = Split(strEmpName, " ") If UBound(arrName) >= 2 Then lastName = "" For i = 1 To UBound(arrName) If i > 1 Then lastName = lastName & " " lastName = lastName & arrName(i) Next i Else MsgBox "يجب إدخال الاسم ثلاثيًا على الأقل", vbExclamation + vbMsgBoxRight, "تنبيه" Exit Sub End If isFemaleName = (Right(NormalizeArabicText(arrName(0)), 1) = "ه") Set rs = db.OpenRecordset("SELECT IDeMP, NameEmployee FROM DatEmp WHERE IDeMP <> " & Me.IDeMP) found = False Do While Not rs.EOF Dim otherEmpName() As String Dim matchingNames As Integer otherEmpName = Split(rs!NameEmployee, " ") For i = 0 To UBound(arrName) arrName(i) = NormalizeArabicText(arrName(i)) Next i For i = 0 To UBound(otherEmpName) otherEmpName(i) = NormalizeArabicText(otherEmpName(i)) Next i If GetLastName(arrName) = GetLastName(otherEmpName) Then If UBound(otherEmpName) >= MIN_MATCHING_NAMES And UBound(arrName) >= MIN_MATCHING_NAMES + 1 Then If arrName(1) = otherEmpName(0) Then matchingNames = 1 For i = 2 To UBound(arrName) If (i - 1) <= UBound(otherEmpName) Then If arrName(i) = otherEmpName(i - 1) Then matchingNames = matchingNames + 1 Else Exit For End If End If Next i If matchingNames > MIN_MATCHING_NAMES Then If isFemaleName Then relation = "ابنة" Else relation = "ابن" End If Me.EntityEmployee = relation Me.NameVerificationEmployee = rs!NameEmployee found = True Exit Do End If ElseIf UBound(arrName) >= MIN_MATCHING_NAMES And UBound(otherEmpName) >= MIN_MATCHING_NAMES Then matchingNames = 0 For i = 1 To UBound(arrName) If i <= UBound(otherEmpName) Then If arrName(i) = otherEmpName(i) Then matchingNames = matchingNames + 1 Else Exit For End If End If Next i If matchingNames > MIN_MATCHING_NAMES Then If isFemaleName Then relation = "أخت" Else relation = "أخ" End If Me.EntityEmployee = relation Me.NameVerificationEmployee = rs!NameEmployee found = True Exit Do End If End If End If End If rs.MoveNext Loop If Not found Then Me.EntityEmployee = "لا يوجد" Me.NameVerificationEmployee = "فردي" End If rs.Close Set rs = Nothing Set db = Nothing End Sub

شكرا لك اخي الكريم وجعلها لك في ميزان حسناتك بالفعل هذا هو المطلوب 🌹

جرب التعديل التالي عله يكون الحل الذي تريده :- Private Sub NameEmployee_AfterUpdate() Dim db As DAO.Database Dim rs As DAO.Recordset Dim strEmpName As String Dim arrName() As String Dim lastName As String Dim relation As String Dim empID As Integer Dim found As Boolean Dim isFemaleName As Boolean Dim i As Integer Set db = CurrentDb() strEmpName = Me.NameEmployee arrName = Split(strEmpName, " ") If UBound(arrName) >= 2 Then lastName = "" For i = 1 To UBound(arrName) If i > 1 Then lastName = lastName & " " lastName = lastName & arrName(i) Next i Else MsgBox "يجب إدخال الاسم ثلاثيًا على الأقل", vbExclamation + vbMsgBoxRight, "تنبيه" Exit Sub End If isFemaleName = (Right(arrName(0), 1) = "ه" Or Right(arrName(0), 1) = "ة") Set rs = db.OpenRecordset("SELECT IDeMP, NameEmployee FROM DatEmp WHERE IDeMP <> " & Me.IDeMP) found = False Do While Not rs.EOF Dim otherEmpName() As String otherEmpName = Split(rs!NameEmployee, " ") If UBound(otherEmpName) >= 1 Then If arrName(1) = otherEmpName(0) Then Dim matchFound As Boolean matchFound = True If UBound(arrName) >= 2 And UBound(otherEmpName) >= 2 Then If arrName(2) <> otherEmpName(1) Then matchFound = False End If End If If matchFound Then If isFemaleName Then relation = "ابنة" Else relation = "ابن" End If Me.EntityEmployee = relation Me.NameVerificationEmployee = rs!NameEmployee found = True Exit Do End If End If End If rs.MoveNext Loop If Not found Then Me.EntityEmployee = "لا يوجد" Me.NameVerificationEmployee = "فردي" End If rs.Close Set rs = Nothing Set db = Nothing End Sub

وعليكم السلام ورحمة الله وبركاته .. قم بإضافة زر إلى نموذج (مثلاً : btnRestore) اجعل الكود التالي كتجربة ( بما انك لم تقم بارفاق قاعدتا البيانات للتجربة ) فيحدث عند النقر للزر السابق :- Private Sub btnRestore_Click() Dim dbPath As String Dim backupPath As String Dim fso As Object Dim fd As FileDialog dbPath = CurrentProject.FullName Set fd = Application.FileDialog(3) With fd .Title = "اختر ملف النسخة الاحتياطية" .Filters.Clear .Filters.Add "ملفات Access", "*.accdb;*.mdb" .AllowMultiSelect = False If .Show = -1 Then backupPath = .SelectedItems(1) Else MsgBox "لم يتم تحديد أي ملف!", vbExclamation + vbMsgBoxRight, "إلغاء العملية" Exit Sub End If End With If Dir(backupPath) = "" Then MsgBox "الملف المحدد غير موجود", vbExclamation + vbMsgBoxRight, "خطأ" Exit Sub End If DoCmd.Close acForm, "اسم_النموذج", acSaveYes DoCmd.Close acReport, "اسم_التقرير", acSaveYes DoCmd.Close acTable, "اسم_الجدول", acSaveYes DoCmd.Close acQuery, "اسم_الاستعلام", acSaveYes Set fso = CreateObject("Scripting.FileSystemObject") fso.DeleteFile dbPath, True fso.CopyFile backupPath, dbPath MsgBox "تم استعادة النسخة الاحتياطية بنجاح ! قد تحتاج إعادة تشغيل البرنامج", vbInformation + vbMsgBoxRight, "نجاح" End Sub يجب توافر المكتبة Microsoft Office XX.0 Object Library

لم اقم بتحميل المرفق ، ولكن جرب التالي بتصحيح بعض الأخطاء .. Private Sub txt_AfterUpdate() Dim selectedYear As Integer If IsNumeric(Me.txt.Value) Then selectedYear = CInt(Me.txt.Value) Else MsgBox "الرجاء إدخال سنة صحيحة", vbExclamation Exit Sub End If Me.Filter = "[totalshy] = 0 OR ([yearshy] <> " & selectedYear & " AND [totalshy] <> 0)" Me.FilterOn = True End Sub

السلام عليكم ورحمة الله وبركاته لحل مشكله اللغه العربيه قم بإزالة علام الصح واضغط ok ثم قم بعمل اعاده تشغيل الجهاز

نعم، أنت محق .ahrambakr بما أن الملف معى يعمل بشكل صحيح ، فالمشكلة بالتأكيد تتعلق بإعدادات نظام التشغيل أو Excel لديك. إليك بعض الخطوات التي يمكنك اتخاذها لحل المشكلة: 1. التحقق من إعدادات اللغة في نظام التشغيل: منطقة اللغة: تأكد من أن "المنطقة" في إعدادات Windows مضبوطة على بلد يستخدم اللغة العربية كلغة أساسية. اذهب إلى "إعدادات" -> "الوقت واللغة" -> "المنطقة". اللغات: تأكد من إضافة اللغة العربية إلى قائمة اللغات المفضلة. اذهب إلى "إعدادات" -> "الوقت واللغة" -> "اللغة". 2. التحقق من إعدادات اللغة في Excel: خيارات اللغة: افتح Excel واذهب إلى "ملف" -> "خيارات" -> "اللغة". تأكد من أن اللغة العربية هي اللغة الافتراضية للعرض والتحرير. خيارات متقدمة: في "خيارات" -> "متقدم"، تحقق من إعدادات "عرض" و"تحرير" المتعلقة باللغات. 3. التحقق من خطوط الكتابة: تنسيق الخلايا: حدد الخلايا التي تحتوي على النص الذي يظهر بشكل غير صحيح. انقر بزر الماوس الأيمن واختر "تنسيق الخلايا". في علامة التبويب "خط"، تأكد من اختيار خط يدعم اللغة العربية بشكل كامل (مثل Arial أو Times New Roman). 4. إعادة تشغيل الجهاز: في بعض الأحيان، قد تتطلب تغييرات إعدادات اللغة إعادة تشغيل الجهاز لتطبيقها بشكل كامل. 5. تحديث Excel: تأكد من أن لديك أحدث إصدار من Excel مثبتًا. قد تحتوي التحديثات على إصلاحات لمشاكل توافق اللغة. 6. تجربة على جهاز آخر: إذا استمرت المشكلة، حاول فتح الملف على جهاز آخر بإعدادات لغة مختلفة لمعرفة ما إذا كانت المشكلة خاصة بجهازك. ملاحظات إضافية: قد يكون هناك تعارض بين بعض إعدادات اللغة في Windows و Excel. قد تكون هناك بعض الملفات المؤقتة التالفة التي تسبب هذه المشكلة. إذا كنت تستخدم إصدارًا قديمًا جدًا من Excel، فقد تواجه مشاكل في توافق اللغة. آمل أن تساعدك هذه الخطوات في حل المشكلة.ahrambakr