AbuuAhmed

هذه دالة تقوم بفرز الأيام البسيطة عن الأيام الكبيسة من شروطها أن يكون يوم النهاية من ضمن الفترة يعني لحساب إجازة لابد إدخال آخر يوم في الإجازة وليس أول يوم مباشرة بعد الإجازة. Function GetYears(ByVal DateFm As Long, ByVal DateTo As Long) As Double Dim Leap004 As Long Dim Leap100 As Long Dim Leap400 As Long Dim LeapYears As Long Dim SmblYears As Long Dim Leap As Long Dim Smbl As Long Dim LeapFm As Long Dim SmblFm As Long Dim inDate As Long Dim yy As Integer 'Years between 102 And 9999 If DateFm < DateSerial(102, 1, 1) Or _ DateTo < DateSerial(102, 1, 1) Then Exit Function 'Swapping If DateFm > DateTo Then inDate = DateFm DateFm = DateTo DateTo = inDate End If '------------------ DateFm = DateFm - 1 '------------------ inDate = DateFm GoSub Calculate LeapFm = Leap SmblFm = Smbl '------------------ inDate = DateTo GoSub Calculate Leap = Leap - LeapFm Smbl = Smbl - SmblFm '------------------ GetYears = (Leap / 366) + (Smbl / 365) Exit Function '------------------ Calculate: yy = Year(inDate) - 1 Leap004 = Fix(yy / 4) Leap100 = Fix(yy / 100) Leap400 = Fix(yy / 400) LeapYears = Leap004 - Leap100 + Leap400 SmblYears = yy - LeapYears Leap = CLng(LeapYears * 366) Smbl = CLng(SmblYears * 365) ' Day(DateSerial(yy + 1, 3, 0)) If day(DateSerial(yy + 1, 3, 1) - 1) = 29 Then Leap = Leap + (inDate - DateSerial(yy, 12, 31)) Else Smbl = Smbl + (inDate - DateSerial(yy, 12, 31)) End If Return End Function

أخي دع عنك استخدام هذه الحسبات (سنة/شهر/يوم) فلن تجد أي دالة في الدنيا ترضيك وكلامي من خبرة طويلة في هذه الأمور. استخدم المدد كأرقام عشرية بتقسيم الأيام على 365.25 للمدد القصيرة (حتى أربع سنوات) وتقسيمها على 365.2425 للمدد الطويلة.

😁 وضح مطلوبك بالتفصيل ، الأمر هين ، سأرجع لك بعد الغدا إن شاء الله ، ألا إذا كنت مستعجل فعلى الزملاء بالفزعة وعدم انتظاري.

في حدث فتح التقرير أضفت لك سطر التركيز على صندوق نص البحث Private Sub cmd_Print_rpt_Click() Me.txtsearch.SetFocus DoCmd.OpenReport "Report0", acViewPreview End Sub

لم تتحدث عن هذه النقطة مث قبل أخي. سألقي نظرة أخرى على المثال.

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

وعليكم السلام المثال بعد التعديل searching_02.accdb

نسخة منقحة ومراجعة كثيرا ، إن شاء الله تخلو من الأخطاء. حاولوا بالفأرة تقليل وزيادة عرض النافذة أثناء التشغيل ومراقبة التوسيط الآلي. RecenterControls_01.accdb

المثال NumLock_TurnOn_01.accdb

برنامج للقرآن الكريم بالأكسس https://drive.google.com/file/d/1oo09ouXvc-3hKYEz3d71avbjckzFfvAG/view

فحص المفتاح وتشغيله عندما يكون لا يعمل: Private Declare Function GetKeyState Lib "user32" (ByVal nVirtKey As Long) As Integer Sub NumLockCheck() If GetKeyState(&H90) = 0 Then mySendKeys "{NUMLOCK}" End Sub

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

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

حاول تبديل السطر البرمجي في مشاركتي السابقة إلى هذا السطر: HeirWidth = (Me.WindowWidth - 3112) / Heirs

بإذن الله سوف تحل كل المشاكل. هل قمت بأي تعديل على التصميم؟ عند ظهور رسالة الخطأ انقر زر Debug ثم قم بأخذ لقطة من الشاشة حاليا وأنا أعمل لحل هذه المشكلة قم باللعب في رقم الـ 20000 في هذا السطر وذلك بإنقاصه 1000 مع كل محاولة: HeirWidth = 20000 / Heirs ملاحظة أقل عدد للأعمدة 10 هو للحفاظ على شكل/مظهر النموذح وإلا بالإمكان أن أجعله عمودا واحدا فقط.

نسخة أخرى بعد تعديل على حدث التراجع. أجر وعافية أخي العزيز ، شافاك الله وعافاك وأرجعك لنا سالما معافى.

ارفع مثالك عزيزي وستجد العون من الجميع إن شاء الله.

أبشر عزيزي تم عمل مراجعة شاملة وإن شاء الله الأمور كلها تحت السيطرة ملاحظات: - لا تستخدم الإستعلام كمصدر للنموذج ، لا حاجة له. - لا داعي للكتابة في حدث بعد التحديث لصناديق المبالغ الموزعة فالبرنامج يقوم بها آليا. - تم تبديل معظم مسميات الصناديق لتسهيل السيطرة والتعديل. - يتكيف مع عدد الورثة آليا على أن لا يتعدى الـ 50 ولا تقل أعمدة الورثة عن 10 وسيتم التعمية على الأعمدة الزائدة عندما يقل عدد الورثة عن 10 - سيتم حساب عرض الأعمدة حسب عددها آليا. - تم تبديل أسماء الجداول والنموذج والوحدات النمطية وحذف الاستعلام. - وددت تبديل أسماء حقول الجداول ولكن تركتها كما هي حتى لا تتسبب لك في مشاكل .. وإذا أردت تبديلها تشاور مع الزملاء. - البرنامج يحتاج إلى تجارب قوية بزيادة عدد الورثة مع كل تحربة. موفقين.

الموضوع السابق:

حركوا ساكن ، لماذا الصمت؟!! توجد مشكلة في الإجراءات السابقة لإجراء التوسيط ، لماذا لا تراجعونها وتحاولون حلها؟ إجراء التوسيط يعمل بكل كفاءة، فقط أضفت سطرا واحدا لحل جزئية سببها الإجراءات السابقة ليتفادى الصناديق التي عرضها صفر ليصبح كالتالي: For Each Ctl In Me.Controls With Ctl If .Width <> 0 Then If .Left < minX Then minX = .Left If .Left + .Width > maxX Then maxX = .Left + .Width End If End With Next Ctl هذه آخر مشاركة لي في هذا الموضوع.

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

للتوثيق

شكرا لك أستاذ موسى. عطلت السطر GenerateDate مع الإعتذار لأنه يتسبب في تعطيل كودي للتوسيط ، لم أفهم السبب. بدلت في كودي الأخير Width إلى WindowWidth AA-3-4_06 (2007).accdb

فضلا وليس أمرا ، حول لي مثالك إلى إصدار 2007

وهذه فكرة ثانية للتجربة أضف زر لإعادة التوسيط وسمه cmdRecenter ونشط الحدث عند النقر وسيكون الكود بهذا الشكل: Private Sub cmdRecenter_Click() Dim Ctl As Control Dim minX As Integer, maxX As Integer, Gap As Integer minX = Me.WindowWidth maxX = 0 For Each Ctl In Me.Controls With Ctl If .Left < minX Then minX = .Left If .Left + .Width > maxX Then maxX = .Left + .Width End With Next Ctl Gap = (Me.WindowWidth - (maxX - minX)) / 2 Gap = Gap - minX If Gap <> minX Then For Each Ctl In Me.Controls With Ctl .Left = .Left + Gap End With Next Ctl End If End Sub جربوا وخبرونا.