AbuuAhmed

لا أعلم إذا دالة التجميع تراعي قيم الـ Null عليه للاحتراز ممكن نحول الجملة أعلاه إلى: "Nz(Loan_Made, 0) - Nz(Payment_Made, 0)"

لم أنزل المثال ولم أهتم بالنتيجة ولكن أحببت أن أقدم نصيحتي بشأن البحث بقيم التاريخ.

المعذرة، أنصح عند عمليات البحث بتحويل حقول التاريخ إلى رقم طويل Long فهي أكثر أمانا للمبرمج: Private Sub txtMonthe_AfterUpdate() Dim Total As Double Dim EndDate As Long EndDate = CLng(CDate(Me.txtMonthe.Value)) Total = Nz(DSum("Loan_Made - Payment_Made", "tbl_Loans", "Clng(Payment_Month)<=" & EndDate & " AND Loan_ID > 0"), 0) Me.Roming = Format(Total, "Standard") End Sub

التعديلات في دالة CheckInkhirat واستدعائها في المرفق. CheckInkhirat.xlsx

أنا كنت أقصد هذا السطر وأخرى كذلك في هذه الدالة: Select Case [Forms]![FrmMenah]![Etar] عموما أنا عدلت في الدالة بحيث تعمل مع النموذجين FrmMenah و FrmCridi عموما تركيزي على عمل الدالة بدون أخطاء برمجية وليس لجلب القيم المطلوبة أعذري أنا دوري انتهى عند هذا الحد بسبب مشكلة صحية وهذا الأمر يتعبني ويصدع رأسي. BAR_A(2025)_01.rar

يعمل هذا النموذج بشرط أن يكون نموذج FrmMenah مفتوحا، وحتى تقوم بالفحص افتح هذا النموذج أولا ثم افتح النموذج FrmCridi المحتوي على المشكلة. هناك كود في الموقع ليفحص لك أي نموج إذا كان مفتوحا أو لا، استفد منه بمنع فتح هذا النموذج إذا كان نموذج FrmMenah غير مفتوح. المشكلة في دالة CheckInkhirat حيث تحتاج إلى قيمة مأخوذة من النموذج FrmMenah.

جرب، المثال في الاستعلام myFormat_01.accdb

إذا تريدها للعرض فقط فسأصمم لك دالة تستدعى من خلال استعلام.

جرب تجعل تنسيق الحقل General Number

حياك الله أخي @Foksh وشكرا على المشاركة، الدالة لتحويل نتائج دالة التفقيط NoToTxt فقط بمحاسنها ومساوئها ونطاقها، الدالة موجودة في ملف الإكسل ضمن مشاركة منتدى الإكسل، الملف به أمثلة كذلك، يستحسن الاطلاع عليه.

الدالة لتحويل نتائج دالة التفقيط NoToTxt (لا أعرف كاتبها) إلى أرقام. وقد كتبتها بناءً على طلب أحد أعضاء منتدى الاكسل. Function NoToTxtRev(ByVal TheTxt As String, MyCur As String, MySubCur As String) As Double 'AbuuAhmed, last update 2024/12/30 'Reverse of NoToTxt function Dim Pos As Integer, Step As Byte, Part4 As Integer, Part As Byte Dim i As Byte, ii As Integer Dim Parts(6), a, b, c Dim Text As String Dim Sum4 As Double, Sum As Double Dim Key0, Key1, Key2, Key3 Dim Sp As Integer Dim Pwr As Integer a = Array("", "مائة", "مائتان", "ثلاثمائة", "أربعمائة", "خمسمائة", "ستمائة", "سبعمائة", "ثمانمائة", "تسعمائة", _ "", "عشر", "عشرون", "ثلاثون", "أربعون", "خمسون", "ستون", "سبعون", "ثمانون", "تسعون", _ "", "واحد", "اثنان", "ثلاثة", "أربعة", "خمسة", "ستة", "سبعة", "ثمانية", "تسعة") b = Array("إحدى", "إثنى", "عشرة", "فقط ", "و ", "ملياران", "مليونان", "ألفان", _ "ومليار", "ومليون", "وألف", "فقط مليار", "فقط مليون", "فقط ألف", "فقط ") c = Array("واحد", "اثنان", "صفر عشر", "فقط ", "و", "اثنان مليار", "اثنان مليون", "اثنان ألف", _ "وواحد مليار", "وواحد مليون", "وواحد ألف", "واحد مليار", "واحد مليون", "واحد ألف", "") Key1 = Array("", "مليار", "ملياران", "مليارات") Key2 = Array("", "مليون", "مليونان", "ملايين") Key3 = Array("", "ألف", "ألفان", "آلاف") For i = 0 To UBound(b) TheTxt = Replace(TheTxt, b(i), c(i)) Next i If MyCur & MySubCur <> "" Then Pos = InStr(1, TheTxt, MyCur) If Pos > 0 Then Parts(5) = Replace(Mid(TheTxt, Pos + Len(MyCur)), MySubCur, "") TheTxt = Left(TheTxt, Pos - 1) Else Pos = InStr(1, TheTxt, MySubCur) If Pos > 0 Then Parts(5) = Replace(TheTxt, MySubCur, "") TheTxt = "" End If End If Else Pos = InStr(1, TheTxt, " ") If Pos > 0 Then Parts(5) = Trim(Mid(TheTxt, Pos + 3)) TheTxt = Left(TheTxt, Pos - 1) End If End If For Part = 1 To 3 Key0 = IIf(Part = 1, Key1, IIf(Part = 2, Key2, Key3)) Pos = InStr(1, TheTxt, Key0(1)) If Pos = 0 Then Pos = InStr(1, TheTxt, Key0(2)) If Pos = 0 Then Pos = InStr(1, TheTxt, Key0(3)) If Pos > 0 Then Parts(Part) = Left(TheTxt, Pos - 1) Pos = InStr(Pos, TheTxt & " ", " ") TheTxt = Mid(TheTxt, Pos) End If Next Part Parts(4) = TheTxt For i = 1 To 5 Parts(i) = Trim(Replace(Parts(i), " و", " ")) Parts(i) = Replace(Parts(i), " احد", " واحد") Next i For Part4 = 0 To 12 Step 3 Part = Part4 / 3 + 1 Sum4 = 0 Sp = 3 - (Len(Parts(Part)) - Len(Replace(Parts(Part), " ", ""))) If Sp < 1 Then Sp = 1 For Step = Sp To 3 Pos = InStr(1, Parts(Part) & " ", " ") Text = Trim(Left(Parts(Part), Pos - 1)) Parts(Part) = Mid(Parts(Part), Pos + 1) If Text <> "" Then For i = 1 To UBound(a) Pwr = 10 ^ (3 - Fix((i - 1) / 10) - 1) ii = i Mod 10 If Text = a(i) Then If Part = 5 Then Sum4 = Sum4 + ii * Pwr Else Sum4 = Sum4 + ii * Pwr * Val("1" & IIf(Part = 5, "", String(9 - Part4, "0"))) End If Exit For End If Next i End If Next Step Sum = Sum + IIf(Part = 5, Sum4 / 100, Sum4) Next Part4 NoToTxtRev = Sum End Function

هذه تساعدك على الترتيب تصاعديا وتنازليا بشكل صحيح = "D:\الهويات\Pictures\" & TEXT(ROW(),"00000") & ".jpg"

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

في هذه الدراسة كيفية التعامل الصحيح مع المدد بين تاريخين آمل أن تكون مفيدة. PeriodsDiff_04.xlsx

لن يخرج الجواب عن مشاركتي السابقة أو مشاركتي هذه بعد إنقاص يوم واحد. PeriodsDiff_03.xlsx