mahmoud nasr alhasany

جرب هذه المعادلة شرح المعادلة ROUND(L4/280*100,1): تقوم هذه الدالة بحساب النسبة المئوية وتقريبها إلى خانة عشرية واحدة. INT(ROUND(L4/280*100,1)): تقوم هذه الدالة بإرجاع الجزء الصحيح من الرقم المقرب. IF(ROUND(L4/280*100,1)=INT(ROUND(L4/280*100,1)),...,...): تقوم هذه الدالة بالتحقق مما إذا كان الرقم المقرب مساويًا للجزء الصحيح منه. إذا كان مساويًا، فهذا يعني أن الرقم صحيح، وإلا فهو عشري. TEXT(ROUND(L4/280*100,1),"0"): إذا كان الرقم صحيحًا، تقوم هذه الدالة بتحويله إلى نص بدون أصفار عشرية. TEXT(ROUND(L4/280*100,1),"0.0"): إذا كان الرقم عشريًا، تقوم هذه الدالة بتحويله إلى نص بخانة عشرية واحدة. مثال إذا كانت L4 تحتوي على 140، فإن الناتج سيكون 50. إذا كانت L4 تحتوي على 141، فإن الناتج سيكون 50.4. آمل أن تكون هذه المعادلة المعدلة تحقق المطلوب. =IF(ROUND(L3/280*100;1)=INT(ROUND(L3/280*100;1));TEXT(ROUND(L3/280*100;1);"0");TEXT(ROUND(L3/280*100;1);"0.0"))

احسنت ا / محمد هشام

وهذا كود معدل لجعل النطاقات في areas تعتمد على LastRow لتكون ديناميكية وتتغير تلقائيًا مع عدد الصفوف في ورقة العمل Private Sub Worksheet_Change(ByVal Target As Range) Dim rng As Range Dim areas As Range Dim lastRow As Long ' تحديد آخر صف يحتوي على بيانات في العمود C (أو أي عمود آخر يحتوي على بيانات) lastRow = Me.Cells(Me.Rows.Count, "C").End(xlUp).Row ' إعداد النطاقات المتعددة باستخدام LastRow Set areas = Union(Me.Range("C10:L" & lastRow), Me.Range("S10:S" & lastRow), Me.Range("V10:V" & lastRow)) ' التعامل مع تغيير الخلايا On Error GoTo ClearApp Application.EnableEvents = False ' منع اللصق إلا كقيم Set rng = Intersect(Target, areas) If Not rng Is Nothing Then Application.Undo ' التراجع عن اللصق الأصلي For Each cell In rng cell.Value = Target.Value ' لصق القيمة فقط Next cell End If ExitHandler: Application.EnableEvents = True Exit Sub ClearApp: Resume ExitHandler End Sub

وهذا الكود الى اخر بيانات مدرجه وليس نطاق معين .Range("A6:AH75").Sort Key1:=.Range("L6:L75"), Order1:=xlDescending, Header:=xlNo .Range("A6:AH75").Sort Key1:=.Range("L6:L75"), Order1:=xlDescending, Header:=xlNo Sub ترتيب_وعرض_أرصدة_العملاء() Dim ws As Worksheet Dim lastRow As Long Dim i As Long Dim totalDebt As Double Set ws = ThisWorkbook.Sheets("ورقة1") With ws ' 1. تحديد LastRow lastRow = .Cells(.Rows.Count, "L").End(xlUp).Row ' 2. ترتيب البيانات تنازليًا حسب رصيد العميل باستخدام LastRow .Range("A6:AH" & lastRow).Sort Key1:=.Range("L6:L" & lastRow), Order1:=xlDescending, Header:=xlNo ' 3. إخفاء الصفوف التي تحتوي على أرصدة غير موجبة أو تساوي صفرًا For i = 6 To lastRow If .Cells(i, "L").Value <= 0 Then .Rows(i).Hidden = True Else .Rows(i).Hidden = False End If Next i ' 4. حساب إجمالي المديونية باستخدام LastRow totalDebt = WorksheetFunction.SumIf(.Range("L6:L" & lastRow), ">0") ' 5. عرض إجمالي المديونية وتنسيقها .Range("AH1").Value = totalDebt .Range("AH1").NumberFormat = "#,##0.00 ""ج.م""" ' تنسيق مخصص ' 6. تنسيق الخلية AI1 With .Range("AI1") .Font.Color = RGB(255, 0, 0) .Font.Bold = True .Value = "إجمالي المديونية: " & totalDebt End With End With End Sub

جرب هذا الكود Private Sub Worksheet_Change(ByVal Target As Range) Dim rng As Range Dim areas As Range Dim cell As Range ' إعداد النطاقات المتعددة Set areas = Union(Me.Range("C10:L109"), Me.Range("S10:S109"), Me.Range("V10:V109")) ' التعامل مع تغيير الخلايا On Error GoTo ClearApp Application.EnableEvents = False ' منع اللصق إلا كقيم Set rng = Intersect(Target, areas) If Not rng Is Nothing Then Application.Undo ' التراجع عن اللصق الأصلي For Each cell In rng cell.Value = Target.Value ' لصق القيمة فقط Next cell End If ExitHandler: Application.EnableEvents = True Exit Sub ClearApp: Resume ExitHandler End Sub

رتيب البيانات: تمت إضافة lastRow = .Cells(.Rows.Count, "L").End(xlUp).Row لتحديد آخر صف يحتوي على بيانات في العمود L (رصيد العميل). هذا يضمن أن الحلقة التالية تغطي جميع البيانات. إخفاء الصفوف: تمت إضافة حلقة For للتكرار على جميع الصفوف من 6 إلى lastRow. داخل الحلقة، يتم التحقق من قيمة رصيد العميل في العمود L. إذا كان الرصيد غير موجب (أقل من أو يساوي صفرًا)، يتم إخفاء الصف باستخدام .Rows(i).Hidden = True. إذا كان الرصيد موجبًا، يتم إظهار الصف باستخدام .Rows(i).Hidden = False (للتأكد من إظهار الصفوف التي قد تكون مخفية سابقًا). حساب إجمالي المديونية: تم استخدام الدالة WorksheetFunction.SumIf لحساب مجموع الأرصدة الموجبة فقط في النطاق L6:L75. تم تخزين النتيجة في المتغير totalDebt. عرض إجمالي المديونية: تمت إضافة السطر .Range("AI1").Value = "إجمالي المديونية: " تمت إضافة السطر . & totalDebt لعرض إجمالي المديونية في الخلية AH1. بللون الاحمر خط عريض وتنسيق القيمة بالجنية المصرى يمكنك تغيير الخلية حسب الحاجة. Sub ترتيب_وعرض_أرصدة_العملاء() Dim ws As Worksheet Dim lastRow As Long Dim i As Long Dim totalDebt As Double Set ws = ThisWorkbook.Sheets("ورقة1") With ws ' 1. ترتيب البيانات تنازليًا حسب رصيد العميل .Range("A6:AH75").Sort Key1:=.Range("L6:L75"), Order1:=xlDescending, Header:=xlNo ' 2. إخفاء الصفوف التي تحتوي على أرصدة غير موجبة أو تساوي صفرًا lastRow = .Cells(.Rows.Count, "L").End(xlUp).Row For i = 6 To lastRow If .Cells(i, "L").Value <= 0 Then .Rows(i).Hidden = True Else .Rows(i).Hidden = False End If Next i ' 3. حساب إجمالي المديونية totalDebt = WorksheetFunction.SumIf(.Range("L6:L75"), ">0") ' 4. عرض إجمالي المديونية .Range("AI1").Value = "إجمالي المديونية: " .Range("AH1").Value = totalDebt .Range("AH1").NumberFormat = "#,##0.00 ""ج.م""" ' تنسيق مخصص ' 5. تنسيق الخلية AH1 With .Range("AH1") .Font.Color = RGB(255, 0, 0) ' تعيين لون الخط إلى الأحمر .Font.Bold = True ' تعيين الخط إلى عريض End With End With End Sub مديونية 2025م(1).xls

ماذالت المشكلة قائمة فى عرض التقارير والخصومات حضور وانصراف 1.xlsm

مشكلة فى عرض تقرير حضور وانصراف بصيغة word/pdf حضور وانصراف 1.xlsm

جرب احدى البرنامجين ده بس حاول تعمل ايميل على اوتلوك برنامج SEND EMAIL.xlsb Send Email (VBA) - Copy.xlsm

جرب هذا الكود تحليل الكود: يقوم الكود بحساب مدة الالتزامات بناءً على شهور البداية والنهاية الموجودة في ورقة عمل Excel، ثم يحسب المدة الإجمالية والمتبقية. الخطوات: تحديد ورقة العمل: يتم تحديد ورقة العمل المسماة "Sheet1" (يمكنك تغييرها حسب الحاجة). حساب مدد الالتزامات: يتم المرور على كل صف في العمود "A" (بدءًا من الصف الثاني). يتم استخراج شهور البداية والنهاية من العمودين "D" و "F" على التوالي. يتم حساب المدة لكل التزام (شهر النهاية - شهر البداية + 1) وتخزينها في العمود "H". يتم حساب المدة الإجمالية لكل الالتزامات. حساب المدة المتبقية: يتم حساب المدة المتبقية بطرح المدة الإجمالية من 240. كتابة النتائج: يتم كتابة المدة الإجمالية والمدة المتبقية في الصفوف التالية لآخر صف مستخدم في العمود "A". رسالة تأكيد: يتم عرض رسالة تأكيد للمستخدم. Sub RoundedRectangle6_Click() Dim ws As Worksheet Dim lastRow As Long Dim i As Long Dim totalDuration As Long Dim remainingDuration As Long Dim startMonth As Long Dim endMonth As Long ' تحديد ورقة العمل Set ws = ThisWorkbook.Sheets("Sheet1") ' استبدل "Sheet1" باسم ورقة العمل الخاصة بك ' حساب مدد الالتزامات lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row For i = 2 To lastRow startMonth = Val(ws.Cells(i, "D").Value) endMonth = Val(ws.Cells(i, "F").Value) ws.Cells(i, "H").Value = endMonth - startMonth + 1 totalDuration = totalDuration + ws.Cells(i, "H").Value Next i ' حساب المدة المتبقية remainingDuration = 240 - totalDuration ' كتابة المدة الإجمالية والمدة المتبقية ws.Cells(lastRow + 2, "A").Value = "المدة الإجمالية:" ws.Cells(lastRow + 2, "B").Value = totalDuration ws.Cells(lastRow + 3, "A").Value = "المدة المتبقية:" ws.Cells(lastRow + 3, "B").Value = remainingDuration ' رسالة تأكيد MsgBox "تم إنشاء الجدول وحساب المدد." End Sub

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

اريد ان ترفق الملف لحل طلبك

هذا الكود لتحويل الأرقام إلى كلمات في العمود B عند إدخال قيمة في العمود A، مع مراعاة اللغة العربية والعملة (الجنيه المصري). شرح الكود: Worksheet_Change: هذا الإجراء يتم تشغيله تلقائيًا عند تغيير أي خلية في ورقة العمل. Tafqit: هذه الدالة الرئيسية تقوم بتحويل الرقم إلى نص، مع مراعاة الجزء الصحيح والجزء العشري. TafqitInteger: هذه الدالة تقوم بتحويل الجزء الصحيح من الرقم إلى نص. TafqitGroup: هذه الدالة تقوم بتحويل مجموعة من ثلاثة أرقام إلى نص (مئات، آلاف، ملايين). ملاحظات هامة: هذا الكود يدعم الأرقام الصحيحة والأرقام العشرية. تمت إضافة دعم للغة العربية والعملة (الجنيه المصري). يمكنك تعديل الكود لتغيير العملة أو لإضافة دعم لعملات أخرى. الكود يعمل علي القيم الموجبة فقط. يمكن إضافة بعض التعديلات علي الكود لتحسينه. آمل أن يكون هذا الكود مفيدًا! Private Sub Worksheet_Change(ByVal Target As Range) Dim cell As Range 'تحديد العمود الذي سيتم مراقبته (العمود A) If Not Intersect(Target, Columns("A")) Is Nothing Then 'المرور على الخلايا التي تم تغييرها For Each cell In Target 'التحقق من أن الخلية تحتوي على قيمة رقمية If IsNumeric(cell.Value) Then 'استدعاء دالة التفقيط ووضع النتيجة في العمود B cell.Offset(0, 1).Value = Tafqit(cell.Value) End If Next cell End If End Sub Function Tafqit(ByVal num As Double) As String Dim strNum As String Dim parts As Variant Dim intPart As Long Dim decPart As Long Dim result As String 'فصل الجزء الصحيح والجزء العشري strNum = Format(num, "0.00") parts = Split(strNum, ".") intPart = CLng(parts(0)) decPart = CLng(parts(1)) 'تفقيط الجزء الصحيح result = TafqitInteger(intPart) 'إضافة كلمة "جنيه" If intPart > 0 Then result = result & " جنيه" End If 'تفقيط الجزء العشري If decPart > 0 Then result = result & " و " & TafqitInteger(decPart) & " قرش" End If Tafqit = result End Function Function TafqitInteger(ByVal num As Long) As String Dim units As Variant, tens As Variant, hundreds As Variant Dim groups(2) As Long Dim result As String Dim i As Integer units = Array("", "واحد", "اثنان", "ثلاثة", "أربعة", "خمسة", "ستة", "سبعة", "ثمانية", "تسعة") tens = Array("", "عشرة", "عشرون", "ثلاثون", "أربعون", "خمسون", "ستون", "سبعون", "ثمانون", "تسعون") hundreds = Array("", "مائة", "مائتان", "ثلاثمائة", "أربعمائة", "خمسمائة", "ستمائة", "سبعمائة", "ثمانمائة", "تسعمائة") groups(0) = num Mod 1000 groups(1) = (num \ 1000) Mod 1000 groups(2) = num \ 1000000 For i = 2 To 0 Step -1 If groups(i) > 0 Then result = result & " " & TafqitGroup(groups(i), i) End If Next i TafqitInteger = Trim(result) End Function Function TafqitGroup(ByVal num As Long, ByVal groupIndex As Integer) As String Dim units As Variant, tens As Variant, hundreds As Variant Dim result As String units = Array("", "واحد", "اثنان", "ثلاثة", "أربعة", "خمسة", "ستة", "سبعة", "ثمانية", "تسعة", "عشرة", "أحد عشر", "اثنا عشر", "ثلاثة عشر", "أربعة عشر", "خمسة عشر", "ستة عشر", "سبعة عشر", "ثمانية عشر", "تسعة عشر") tens = Array("", "عشرة", "عشرون", "ثلاثون", "أربعون", "خمسون", "ستون", "سبعون", "ثمانون", "تسعون") hundreds = Array("", "مائة", "مائتان", "ثلاثمائة", "أربعمائة", "خمسمائة", "ستمائة", "سبعمائة", "ثمانمائة", "تسعمائة") If num >= 100 Then result = result & hundreds(num \ 100) & " " num = num Mod 100 End If If num >= 20 Then result = result & tens(num \ 10) & " " & units(num Mod 10) ElseIf num >= 10 Then result = result & units(num) Else result = result & units(num) End If Select Case groupIndex Case 1 If num > 0 Then result = result & " ألف" Case 2 If num > 0 Then result = result & " مليون" End Select TafqitGroup = Trim(result) End Function صيغة تفقيط.xlsm

المشكلة التي تواجهك في VBA Excel عند تحويل الأرقام إلى كلمات وظهور علامات استفهام أو حروف غير مفهومة، هي مشكلة شائعة تتعلق بترميز الأحرف (Encoding) في VBA. إليك شرح للمشكلة وحلولها: سبب المشكلة: ترميز الأحرف: VBA يستخدم ترميزًا معينًا للأحرف، وأحيانًا لا يتوافق هذا الترميز مع الترميز المستخدم في النص الذي تحاول تحويله. عندما يكون هناك عدم توافق في الترميز، تظهر الأحرف بشكل غير صحيح، مثل علامات الاستفهام أو الرموز الغريبة. إعدادات اللغة: إعدادات اللغة في نظام التشغيل وفي Excel يمكن أن تؤثر على كيفية عرض الأحرف. إذا كانت إعدادات اللغة غير متوافقة، فقد تظهر الأحرف بشكل غير صحيح. حلول المشكلة: استخدام ترميز UTF-8: UTF-8 هو ترميز عالمي يدعم معظم اللغات، بما في ذلك اللغة العربية. يمكنك محاولة تحويل النص إلى ترميز UTF-8 قبل عرضه في Excel. هذا الحل يحتاج الي تعديل الكود المسئول عن تحويل الارقام الي نص. تغيير إعدادات اللغة في Excel: تأكد من أن إعدادات اللغة في Excel متوافقة مع اللغة العربية. يمكنك التحقق من ذلك من خلال: ملف > خيارات > اللغة. تأكد من أن اللغة العربية هي اللغة الافتراضية. تغيير إعدادات اللغة في نظام التشغيل: تأكد من أن إعدادات اللغة في نظام التشغيل متوافقة مع اللغة العربية. يمكنك التحقق من ذلك من خلال: لوحة التحكم > المنطقة واللغة. استخدام دوال تحويل الأرقام إلى كلمات جاهزة: هناك بعض الدوال الجاهزة التي يمكن استخدامها لتحويل الأرقام إلى كلمات باللغة العربية. قد تكون هذه الدوال أكثر موثوقية من الدوال المخصصة التي قد تواجه مشاكل في الترميز. يوجد الكثير من الاكواد الجاهزة علي الانترنت التي تقوم بنفس الغرض. التأكد من خطوط الكتابة: بعض الخطوط لا تدعم اللغة العربية بشكل كامل, لذلك يجب التأكد من الخط المستخدم داخل ملف الاكسل يدعم اللغة العربية. نصائح إضافية: إذا كنت تستخدم دالة مخصصة لتحويل الأرقام إلى كلمات، فحاول البحث عن تحديثات أو إصلاحات لهذه الدالة. إذا كنت تستخدم دالة خارجية، فتأكد من أنها متوافقة مع إصدار Excel الذي تستخدمه. تاكد من حفظ ملف الاكسل بصيغة تدعم اللغة العربية بشكل كامل. آمل أن تساعدك هذه الحلول في حل المشكلة الرجاء ان ترفق الملف اذا لم تنجح معك الحلول السابقة للمساعدتك

تفضل ورقة ارسال عن طريق الواتس اسهل طريقة ارسال وربط ملف الاكسيل بالواتس اب وارسال رسائل المدرسة او الشركة من الاكسيل للواتس اب.xlsm