فصل وتوزيع الارقام شخابيط وافكار : فصل الارقام مثل (الرقم القومى/الهوية) - الرقم التآمينى .. الخ

[ابو جودي]

السلام عليكم ورحمة الله تعالى وبركاته

كل عام وانتم بخيــر

يأتى شهر الخير ومعه البركات

ذات مرة شاركت فى موضوع بخصوص فصل الرقم القومى 

وهذا هو الموضوع 

ولكن بصراحه انا معقد بطبعى ولا اهوى الحلول المعتادة والتى تستدعها اعدادها بشكل خاص فى كل مره

ولذلك كتبت اجراء ذكي هههههههههه محدش يضحك  😡 شايفكم
يوفر العديد من العناء والاستعلامات ووجع الراس
ده غير المرونه والــ ...... ما تيجوا نشوف أحسن

اولا : وحدة نمطيه عامة باسم : basDistributeNumeric

الاكواد داخل الوحدة النمطيه هى : 

' إجراء لفحص ما إذا كان النص يحتوي على أرقام فقط
Function IsNumericOnly(ByVal InputString As String) As Boolean
    Dim i As Integer
    Dim char As String
    
    ' التحقق من أن السلسلة ليست فارغة
    If Len(InputString) = 0 Then
        IsNumericOnly = False
        Exit Function
    End If
    
    ' التحقق من أن كل حرف هو رقم فقط
    For i = 1 To Len(InputString)
        char = Mid(InputString, i, 1)
        If Not (char >= "0" And char <= "9") Then
            IsNumericOnly = False
            Exit Function
        End If
    Next i

    ' إذا كانت جميع الأحرف أرقام، ترجع True
    IsNumericOnly = True
End Function

الغرض : التأكد من ان القيمه التى سوف يتم تمريرها هى أرقام

ثم الإجراء الرئيسي : لفصل الأرقام

'  إجراء لفصل و توزيع القيم الرقمية اما فى متغير او عنصر تحكم مثل مربع نص
Public Sub DistributeNumericInput(Optional TargetObject As Object = Nothing, Optional InputValue As Variant, Optional MaxFields As Integer = 14, Optional ControlPrefix As String = "txt")
    Dim Index As Integer
    Dim ControlItem As Control
    Dim TextBoxCollection As Object ' Dictionary لتخزين مربعات النص
    Dim TargetTextBox As Control ' لتعريف كل مربع نص عند التكرار
    Dim NumericString As String
    Dim DictKey As Variant ' لتجنب مشاكل الفهارس عند التعامل مع Dictionary

    ' التحقق من نوع الإدخال ومعالجته
    If TypeName(InputValue) = "TextBox" Then
        If IsNull(InputValue.Value) Or Not IsNumericOnly(InputValue.Value) Then
            MsgBox "الإدخال غير صالح، يرجى إدخال أرقام فقط!", vbExclamation, "خطأ"
            Exit Sub
        End If
        NumericString = InputValue.Value
    ElseIf VarType(InputValue) = vbString Or VarType(InputValue) = vbVariant Then
        If Not IsNumericOnly(InputValue) Then
            MsgBox "الإدخال يجب أن يحتوي على أرقام فقط!", vbExclamation, "خطأ"
            Exit Sub
        End If
        NumericString = InputValue
    Else
        MsgBox "نوع الإدخال غير مدعوم، يرجى إدخال مربع نص أو قيمة رقمية نصية!", vbCritical, "خطأ"
        Exit Sub
    End If

    ' إنشاء قاموس لتخزين مربعات النص ذات البادئة المحددة فقط
    Set TextBoxCollection = CreateObject("Scripting.Dictionary")

    ' البحث عن مربعات النص المناسبة داخل النموذج أو التقرير
    If Not TargetObject Is Nothing Then
        For Each ControlItem In TargetObject.Controls
            ' التأكد من أن العنصر هو مربع نص ويمتلك البادئة المحددة
            If TypeName(ControlItem) = "TextBox" And Left(ControlItem.Name, Len(ControlPrefix)) = ControlPrefix Then
                Index = Val(Mid(ControlItem.Name, Len(ControlPrefix) + 1)) ' استخراج الرقم من اسم مربع النص
                If Index >= 1 And Index <= MaxFields Then
                    TextBoxCollection.Add Index, ControlItem
                End If
            End If
        Next ControlItem
    End If

    ' مسح محتوى مربعات النص إذا كان هناك مربعات متاحة
    If TextBoxCollection.Count > 0 Then
        For Each DictKey In TextBoxCollection.Keys
            TextBoxCollection(DictKey).Value = "" ' مسح القيم
        Next DictKey
    End If

    ' التحقق من توفر عدد كافٍ من مربعات النص
    If TextBoxCollection.Count > 0 And TextBoxCollection.Count < Len(NumericString) Then
        MsgBox "عدد مربعات النص غير كافٍ لعرض كافة الأرقام!", vbExclamation, "خطأ"
        Exit Sub
    End If

    ' توزيع الأرقام على مربعات النص
    For Index = 1 To Len(NumericString)
        If Index > MaxFields Then Exit For
        If TextBoxCollection.Exists(Index) Then
            Set TargetTextBox = TextBoxCollection(Index)
            TargetTextBox.Value = Mid(NumericString, Index, 1)
        Else
            Call PrintDigitInfo(Index, ControlPrefix, NumericString)
        End If
    Next Index
    
    ' تنظيف المتغيرات
    Set TextBoxCollection = Nothing
    Set TargetTextBox = Nothing
End Sub

الغرض : الفصل والتوزيع
تم كتابة الإجراء السابق بشكل احترافى ومرن ليمكن استدعاءه بتمرير معاملات اليه بكل مرونه
الفوائد :

✔ مرونة فائقة : يمكن استدعاء الإجراء دون الحاجة إلى تمرير Target Object إذا لم يكن مطلوبا
✔ دعم إستخدام القيم بشكل مباشر : يمكن استخدامه فقط لمعالجة قيمة رقمية وطباعة النتيجة بدلا من الحاجة إلى نموذج أو تقرير
✔ دعم الاستخدام الأمثل لتعبئة القيم : يمكن استخدامه لمعالجة القيم أو تعبئة مربعات النص حسب الحاجة

✔ الاستدعاء مع نموذج أو تقرير >>--> 
                تحديد النموذج او التقرير الحالي من خلال استخدام : Me
                تمرير اسم العنصر الذى يحتوى على القيم الرقميه " اسم مربع النص"
                لو تم الاكتفاء بذلك سوف يقوم الإجراء بفصل عدد 14 رقم  وهو المستخدم فى الكود اختياريا
                أو يمكن تمرير عدد الارقام الذى تريده حسب الحاجة  و هنا قمة المتعة والمرونه 
                 ثم بعد ذلك تمرر البادئه الخاصة باسماء مربعات النص التى تسبق الارقام
" يعنى مثلا مع الرقم القومى سوف استخدم عدد 14 مربع يبدأ  بالبادئة : txtNatId ثم الرقم من 1 الى الرقم 14 "
فى الاستدعاء التالى مثلا تحصل على فصل وتوزيع 14 أرقام

Call BindTextBoxes(Me, "txtIns", 14, "txtNatId "

أو ممكن بهذا الشكل فى هذه الحاله يتم استخدام الرقم الاختيارى المفضل ضمن الكود وهو 14 

Call BindTextBoxes(Me, "txtIns", , "txtNatId "

*  وماذا لو كان هناك اكثر من رقم مثلما هو موجود فى الموضوع المشار إليه مثل الرقم التأمينى , كود المنشأه ونريد فصلهم بنفس الآليه

وهذا هو ما دفعنى الى التفكير فى كتابة هذه الإجراءات الذكيه والتى يمكنها التعامل مباشرة بكل سهولة مع اى سلسلة رقميه مهما كان طولها أو اختلفت 

طيب لاعادة الاستدعاء مع امثلة أخري مثل الرقم التآمينى مثلا
                تحديد النموذج او التقرير الحالي من خلال استخدام : Me
                تمرير اسم العنصر الذى يحتوى على القيم الرقميه " اسم مربع النص"
                لو تم الاكتفاء بذلك سوف يقوم الإجراء بفصل عدد 14 رقم  وهو المستخدم فى الكود اختياريا
                أو يمكن تمرير عدد الارقام الذى تريده حسب الحاجة  و هنا قمة المتعة والمرونه  سوف نستخدم مثلا 10 أرقام
                 ثم بعد ذلك تمرر البادئه الخاصة باسماء مربعات النص التى تسبق الارقام
مثلا مع الرقم التآمينى سوف استخدم عدد 10 مربع يبدأ  بالبادئة : txtIns ثم الرقم من 1 الى الرقم 10"

Call DistributeNumericInput(Me, lngInsuranceID, 10, "txtIns")

وهكذا حسب الحاجة وحسب الرغبه 

*  اذا أردانا التجربة للطباعة داخل النافذة الفورية على سبيل التجربة 

' لتجربة طباعة النتيجة مباشرة في النافذة الفورية
Private Sub PrintDigitInfo(Index As Integer, ControlPrefix As String, NumericString As String)
    Debug.Print "Digit Index " & Format(Index, "00") & " is : >>-> " & ControlPrefix & " " & Mid(NumericString, Index, 1)
End Sub

ونكتب مباشرة فى النافذة الفورية على سبيل المثال :

DistributeNumericInput , "9876543210",5,""

سوف نحصل منها على النتيجة التاليه لفصل الارقام الخمسة الاولى 
Digit Index 01 is : >>->  9
Digit Index 02 is : >>->  8
Digit Index 03 is : >>->  7
Digit Index 04 is : >>->  6
Digit Index 05 is : >>->  5

- طيب لنفترض اناا نريد تنفيذ عملية الفصل والتوزيع فى نموذج مستمر :
 برضو كتبت لكم إجراء ذكى لعمل استعلام ديناميكى 
الكود فى الوحدة النمطيه

' إجراء لإنشاء استعلام ديناميكي بناءً على الحقول المدخلة
Public Function GenerateDynamicSQL(tableName As String, ParamArray RequiredFieldsDistribute() As Variant) As String
    Dim sqlQuery As String
    Dim i As Integer
    Dim fieldName As String
    Dim maxDigits As Integer
    Dim fieldPrefix As String
    Dim fieldInfo As Variant
    
    ' بدء بناء جملة SQL
    sqlQuery = "SELECT " & tableName & ".*, "
    
    ' معالجة كل حقل مطلوب مع عدد الأرقام والبادئة الخاصة به
    For Each fieldInfo In RequiredFieldsDistribute
        fieldName = fieldInfo(0)  ' اسم الحقل
        maxDigits = fieldInfo(1)  ' عدد الأرقام المطلوب توزيعها
        fieldPrefix = fieldInfo(2) ' البادئة المخصصة للحقول
        
        ' إنشاء الحقول المحسوبة لكل رقم في الحقل المطلوب مع البادئة
        For i = 1 To maxDigits
            sqlQuery = sqlQuery & "IIf(IsNull([" & fieldName & "]) OR Len([" & fieldName & "]) < " & i & ", Null, Mid([" & fieldName & "], " & i & ", 1)) AS " & fieldPrefix & i & ", "
        Next i
    Next fieldInfo
    
    ' إزالة الفاصلة الأخيرة لإكمال الجملة بشكل صحيح
    sqlQuery = Left(sqlQuery, Len(sqlQuery) - 2)
    
    ' إضافة جملة FROM
    sqlQuery = sqlQuery & " FROM " & tableName & ";"
    
    ' إرجاع جملة SQL النهائية
    GenerateDynamicSQL = sqlQuery
End Function

الغرض : عمل استعلام ديناميكى بكل سهولة ليكون مصدر بيانات للنموذج المستمر
الفوائد :

✔ مرونة فائقة : تمرير اسم الجدول الذى يحتوى على حقل/حقول الأرقام المراد فصلها وتوزيعها
✔ مرونة فائقة : تمرير اسم (الحقل/حقول) للأرقام وذلك من خلال مصفوفة وفق الإجراء السابق

الكود فى الوحدة النمطيه :

' إجراء للتحقق من وجود عنصر التحكم في النموذج
Private Function ControlExists(frm As Form, ctrlName As String) As Boolean
    On Error Resume Next
    ControlExists = Not (frm.Controls(ctrlName) Is Nothing)
    On Error GoTo 0
End Function

' إجراء لربط مربعات النص بحقول البيانات تلقائيًا
Sub BindTextBoxes(frm As Form, prefix As String, maxDigits As Integer)
    Dim i As Integer
    Dim ctrlName As String
    
    ' تعيين الحقول بناءً على العدد الصحيح لكل نوع
    For i = 1 To maxDigits
        ctrlName = prefix & i
        
        ' التحقق من وجود العنصر قبل تعيين ControlSource
        If ControlExists(frm, ctrlName) Then
            frm.Controls(ctrlName).ControlSource = ctrlName ' الحقل مرتبط مباشرة بالاستعلام
        End If
    Next i
End Sub

الفوائد : التأكد من وجود عناصر التحكم اللازمة 
أجراء لربط الحقول مع العناصر الخاصة بناء على الفصل  وذلك لعملية التوزيع 
 

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

Private Sub Form_Open(Cancel As Integer)
    ' تعريف متغير لتخزين جملة SQL
    Dim sqlStatement As String
    
    ' إنشاء استعلام SQL ديناميكي لجلب البيانات المطلوبة مع توزيع الأرقام في الحقول
    sqlStatement = GenerateDynamicSQL("tblEmployees", _
                                      Array("NationalID", 14, "txtNatId"), _
                                      Array("InsuranceID", 10, "txtIns"), _
                                      Array("OrganizationID", 10, "txtOrg"))

    ' تعيين جملة SQL كمصدر بيانات للنموذج
    Me.RecordSource = sqlStatement
    
    ' إعادة تحميل البيانات بعد تحديث مصدر السجلات
    Me.Requery
End Sub

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

Private Sub Form_Current()
    ' ربط مربعات النصوص ببيانات الهوية القومية (14 خانة)
    Call BindTextBoxes(Me, "txtNatId", 14)
    
    ' ربط مربعات النصوص ببيانات الرقم التأميني (10 خانات)
    Call BindTextBoxes(Me, "txtIns", 10)
    
    ' ربط مربعات النصوص ببيانات كود المنشأة (10 خانات)
    Call BindTextBoxes(Me, "txtOrg", 10)
End Sub

بذلك نضمن فصل وتوزيع الارقام بشكل آلى 
 

* طيب الان لو أردنا عمل الفصل والتوزيع داخل تقرير :
فى تصميم التقرير نقوم بالاعلان عن المتغيرات التاليه

' تعريف متغيرات لتخزين القيم النصية للأرقام
Dim lngNationalID As String
Dim lngInsuranceID As String
Dim lngOrganizationID As String

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

Private Sub Detail_Format(Cancel As Integer, FormatCount As Integer)
    ' تحديث القيم بناءً على السجل الحالي لمربع النص المرتبط بالرقم القومي
    If Not IsNull(Me!txtNationalID) Then
        lngNationalID = Trim(Me!txtNationalID) ' إزالة المسافات الفارغة من بداية ونهاية النص
    Else
        lngNationalID = "" ' تعيين قيمة فارغة في حالة عدم وجود بيانات
    End If
    
    ' تحديث القيم بناءً على السجل الحالي لمربع النص المرتبط بالرقم التأميني
    If Not IsNull(Me!txtInsuranceID) Then
        lngInsuranceID = Trim(Me!txtInsuranceID) ' إزالة المسافات الفارغة من بداية ونهاية النص
    Else
        lngInsuranceID = "" ' تعيين قيمة فارغة في حالة عدم وجود بيانات
    End If

    ' استدعاء الدالة لتوزيع الأرقام على مربعات النصوص المرتبطة بالرقم القومي
    Call DistributeNumericInput(Me, lngNationalID, 14, "txtNatId")
    
    ' استدعاء الدالة لتوزيع الأرقام على مربعات النصوص المرتبطة بالرقم التأميني
    Call DistributeNumericInput(Me, lngInsuranceID, 10, "txtIns")
End Sub

Private Sub PageHeaderSection_Format(Cancel As Integer, FormatCount As Integer)
    ' تحديث القيم بناءً على السجل الحالي لمربع النص المرتبط بكود المنشأة
    If Not IsNull(Me!txtOrganizationID) Then
        lngOrganizationID = Trim(Me!txtOrganizationID) ' إزالة المسافات الفارغة من بداية ونهاية النص
    Else
        lngOrganizationID = "" ' تعيين قيمة فارغة في حالة عدم وجود بيانات
    End If
    
    ' استدعاء الدالة لتوزيع الأرقام على مربعات النصوص المرتبطة بكود المنشأة
    Call DistributeNumericInput(Me, lngOrganizationID, 10, "txtOrg")
End Sub

---------------------------------------------

صورة توضيحيه من نموذج مفرد


---------------------------------------------
صورة توضيحية من نموذج مستمر


---------------------------------------------
صورة توضيحية من تقرير

واخيــــرا المرفق 
أتمنى أن تكونوا قد إستمتعتم معنا فى منتدانا الرائـــــــع 

 

فصل و توزيع ارقام الرقم القومى.zip

[Lotfy14]

شرح مفصل لكل شئ مشاء الله

رغم ان دماغى تاهت شوية معاك بس هفوق للفكرة دا بعد الفطار وهمشى معاك فى الخطوات المشروحه

احب افهم الفكرة مش بحب اشوف الحل واريح دماغى

اخى ابو جودي

انا صاحب الموضوع السابق واكيد ذى ما الاخ kkhalifa1960

افدنى برده وحل مشكلتى على احسن وجه

اكيد ابقى حابب افهم فكرة حضرتك واجربىها برضة

لك منى كل احترامى على مجهوده الجبار ويارب دايما اوشفك فى طلباتى بالمنتدى

[ابو جودي]

السلام عليكم ورحمة الله وبركاته

اولا

16 ساعات مضت, Lotfy14 said:

واكيد ذى ما الاخ kkhalifa1960

افدنى برده وحل مشكلتى على احسن وجه

ده كده كده

هو احد اساتذة المنتدى العظماء الذين ادين لهم بكل الفضل بعد رب العزة سبحانه وتعالى فكل الشكر والتقدير والاحترام والإجلال والعرفان بالجميل لكل اساتذتنا العظماء بارك الله تعالى لنا فيهم وبارك لهم فى اعمارهم وعلمهم وعملهم وجعله فى موازين اعمالهم ان شاء الله علم ينتفع به وصدقة جارية

شكر الله تعالى لهم حسن تحملهم لنا واسال الله تعالى ان يحسن اليهم كما يحسنون الينا والى كل طلاب العلم بدون كلل ولا ملل ... امين امين امين

 

16 ساعات مضت, Lotfy14 said:

شرح مفصل لكل شئ مشاء الله

اشكرك جدا جزاكم الله خيـرا 

 

16 ساعات مضت, Lotfy14 said:

رغم ان دماغى تاهت شوية معاك بس هفوق للفكرة دا بعد الفطار وهمشى معاك فى الخطوات المشروحه

طيب طلما ان دماغك تاهت شويه صغيرين بس وناوى تفوق وتمشى خطوة خطوه

تعالى نروح الملاهى وخليها تتوه اكثر  

 

16 ساعات مضت, Lotfy14 said:

احب افهم الفكرة مش بحب اشوف الحل واريح دماغى

عاوزك بقه تفهم الافكار الجديده فى التعديلات الأخيره فى المرفق الجديد هنا

 

تم فصل كل منطق فى داله منفصله هذا افضل للصيانه وفى اضافة اى تعديلات فى خطوة محدده 

تم الاستغناء عن الحقول الغير منضمه مع النموذج المستمر وذلك حتى لا استخدم اى اكود فى حدث النموذج الحالى وذلك للحصول على اكبر قدر ممكن من السرعة فى الاداء والكفاءه عند معالجة البيانات وكذلك اقلل من اسطر استدعاء الاكواد عند الاستخدام

ولذلك تم اضافة اجراءات جديده داخل الوحده النمطيه

الجديد هنا : فصل تاريخ الميلاد وتوزيعه بشكل صحيح بطريقة اليه من خلال الرقم القومى انظر النتيجة داخل التقرير 
 

المنطق الذى احبه وابنى الكود بناء عليه هو التالى : 
لا يهمنى كم او عدد الاسطر داخل الوحدات النمطيه العامة بقدر المرونة والسهوله فى الاستدعاء والحصول على كل المتطلبات بقدر الامكان 
بقدر الامكان ان يكون الكود داخل الوحده النمطيه عام وشامل ليحقق العديد من الوظائف فى نفس الوقت دون التقييد 

النتيجه :  فقط نقل الوحده النمطيه كما هى الى اى قاعدة بيانات ومراعاة طريقة الاستدعاء فقط للاكواد حسب الحاجه والحصول على العديد من النتائج حسب الرغبه بحسب طريقة الاستدعاء من نفس الجراءات والوظائف المستخدمه  شغل فاخر من الاخر ودوال ذكيه بحق وحقيقى انت بس تفهمها وهى هتفهمك وتحقق احلامك 

- لذلك سوف تلاحظ ان الوحده النمطيه الان تقوم بعمل كل شئ الفصل لكل الارقام المختلفة التآمينى - المنشآة - الرقم القومى وتوزيع الاعداد بعد الفصل 
وكذلك استخراج وتوزيع تاريخ الميلاد من الرقم القومى 
ولو عاوز من الرقم القومى مكان الميلاد  وكمان نوع الجنس : ذكر/انثى ممكن عمل ذلك فى التحديث القادم ان اردت  
 

 

 

مثل ما هو واضح من هذه الصورة

 

يلا راجع وحلل وتتبع الاكواد ولو وقف معاك حاجه قول 

------------------------------------

مرفق : التحديث الجديد

 

 

 

فصل وتوزيع ارقام الرقم القومى 2.accdb

[Lotfy14]

حبيبى ( اخى ابو جودي )

بصراحه هاااايل فى افكارك وحلولك البسيطة ولكن كعمل كبييييرة

ملحوظة
لو انت مكرر كود المنشأة وعامله رقم متسلسل للتجربة على انه مثال فدا تمام

ولكن من الطبيعى ان المنشأة ملتزمة برقم واحد بالكشوف التامينية وليس لكل موظف كود للمنشاة المفروض انها مكان عمل واحد

 

ندخل بقى على المهم
انت عملت استخراج تاريخ الميلاد من الرقم القومى فى مربع لكل يوم وشهر وسنة ... تمام

ولكن من الطبيعى يبقى تاريخ التحاق بالعمل ، بس هنعتبرة يمشى وممكن الغى واخلى الداله تبص لتاريخ الالتحاق

 

ولكن عوزك تخلى الموضوع كامل متكامل بجد
الاجر التامين دا بيبقى عبارة ان رقم ثابت وبعلامة عشرية 2

بمعنى الرقم بيبقى مثلا ( 3800.00 ) او ( 3500.50 ) عوزين نبقى نفصل الرقم الصحيح فى مربع والرقم العشرى فى مربع لوحده

فهمنى طبعا

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

مع العلم ان الكشوف بتبقى بترتيب الرقم التامين وليس بترتيب اي رقم اخر
يعنى كل موظف سواء تاريخ التحاقه بالعمل حديث او قديم المهم والتركيز بيبقى على الرقم التأمين فى الاولوية بالكشف
 

يالا يا فنان ابدع وورينا افكارك

تم تعديل مارس 13 بواسطه Lotfy14

[hanan_ms]

استاذي العزيز @ابو جودي ❤️🌹🌹☕

 في دالة اتذكر انا سويتها لحصر الارقام من الشمال الى اليمين  مع تحديد عدد ارقام المدني القومي لكافة الدول 😇 

 

( حقل واحد )التقرير يكون حقل متصل برقم المدني القومي 

لاختلاف اعداد الرقم المدني القومي من دولة الى اخرى

 

لو عندي فك لشفرة ارقام المدنية القومية للدول الاخرى  لرفقتها لسرعة ادخال البيانات واشرايك تاخذ الرقم بتمرير الكاميرا في (في قلم تمسح على ورقة او على بطاقة ينقل نص  مباشر الى الحقل يمكن الشراء وتجربة في امازون او محلات الكمبيوتر اتذكر كان نازل قبل جائحة اكرونا)

 

 مجهزا لكم تحديث باقرب وقت ارفعة قبل لا اكمل نطاق الجغرافي 2  اقصد الي قبله فيه الصلاحيات والاعدادة بختصار نظام ينشأ نظام كالاوريكل نفس الطريقة لانشاء وتصميم الاوريكل ولكن نظام  اسرع من الاوركيل وخيارات متعدده لانجاز مشروعك

 

يمكن انا الوحيده الى سوت نظام لينشأ نظام في الموقع   

 

شوف لي نظره على المشروع بعد ما ارفع 

تم تعديل مارس 13 بواسطه hanan_ms

[ابو جودي]

5 ساعات مضت, Lotfy14 said:

ندخل بقى على المهم
انت عملت استخراج تاريخ الميلاد من الرقم القومى فى مربع لكل يوم وشهر وسنة ... تمام

ولكن من الطبيعى يبقى تاريخ التحاق بالعمل ، بس هنعتبرة يمشى وممكن الغى واخلى الداله تبص لتاريخ الالتحاق

انا اشتغلت على مرفق فى موضوعك الاصلى وانت اللى كنت كاتب تاريخ الميلاد  

 

5 ساعات مضت, Lotfy14 said:

ولكن عوزك تخلى الموضوع كامل متكامل بجد
الاجر التامين دا بيبقى عبارة ان رقم ثابت وبعلامة عشرية 2

بمعنى الرقم بيبقى مثلا ( 3800.00 ) او ( 3500.50 ) عوزين نبقى نفصل الرقم الصحيح فى مربع والرقم العشرى فى مربع لوحده

فهمنى طبعا

انا صعيدى وفهمى على اد حالى بس هحاول افهم حاضر 

 

5 ساعات مضت, Lotfy14 said:

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

 

طبعا انت تقصد الترتيب ده داخل التقرير صح ؟

 

[Lotfy14]

حبيبى يا صعيدى يا عسل

اسف على التاخير للانشغالى ببعض الوقت الفترة السابقة

اولا : تاريخ المسلاد :.

فعلا انا كتبت تاريخ الميلاد ودى كانت غلطة مش مقصوده ولكن المعنى فى بطن الشاعر

اللى هينطبق على تاريخ الميلاد هو هو تاريخ التعيين

ولما طلبت منك التعديل كنت اقصد علشان الكل يستفاد من الموضوع ويبقى مبنى على اساس صحيح

ثانيا : فصل الارقام( المبلغ ) :.

هقولك بص يا سيدى احنا قلنا الرقم مثلا هيبقى ( 3800.00 ) صح كدا

عوزين نفصل الرقم دا ليصبح [ 3800.00 ] فى مربع لوحده والــ [ 00 ] فى مربع اخر

او الرقم الثانى بتاع مثلا اللى هو ( 3500.50 ) يبقى[ 3500 ] فى مربع و الــ [ 50 ] فى مربع اخر

يعنى الرقم الصحيح فى مربع ولو فى رقم بعد العلامة العشرية يبقى فى مربع لوحده

ولو الرقم صحيح من غير علامة عشرية يبقى الخانة الثانية اللى بعد الرقم عبارة عن 00

اعتقد ان الصعيده كدا ملهمش دعوه بالموضوع 😂

ثالثا : الترتيب طبعا بيبقى داخل التقرير

انا مش هشتغل على فورم والمفروض ميبقاش على فور

دا بيبقى عباره عن بوتن اقوله فيما معناه اطبعلى كل الناس المؤمن عليهم من غير ما ادخل فى اعداد تقرير

هو التقرير بيحضر نفسة بنفسة لما اختار من البوتن المؤمنين عليهم ذى ما قلت

وبيبقى الترتيب حسب الرقم التامين بس مش بتاريخ ميلاد ولا تاريخ تعيين ولا رقم قومى

اشتغل على الرقم التامينى

عارف انك عبقرى ودى بجد اقسم بالله

 

حبيبى انا تعبك معايا واكيد الواحد بيتعلم منك ومن كل واحد بالمنتدى ومن غير المنتدى واللى فيه

مكنتش وصلت لحاجة فى شغلى بفضلكم بعد ربنا سبحانه وتعاله

[ابو جودي]

2 ساعات مضت, Lotfy14 said:

حبيبى يا صعيدى يا عسل

والله انت اللى عسل الله يجبر بخاطرك 

 

---------------------------------------

1 ساعه مضت, Lotfy14 said:

فعلا انا كتبت تاريخ الميلاد ودى كانت غلطة مش مقصوده ولكن المعنى فى بطن الشاعر

اللى هينطبق على تاريخ الميلاد هو هو تاريخ التعيين

هو بنفس المنطق لكن مش حيكون بنفس الكود لان انا كتبت لك الكود يستخرج تاريخ الميلاد بشكل الى من الرقم القومى بدون ان تكتب انت التاريخ اصلا 

اما فى حالتك الموضوع مختلف انت سوف تقوم بادخال التاريخ

ابشر ان شاء الله

 

---------------------------------------

2 ساعات مضت, Lotfy14 said:

انيا : فصل الارقام( المبلغ ) :.

هقولك بص يا سيدى احنا قلنا الرقم مثلا هيبقى ( 3800.00 ) صح كدا

عوزين نفصل الرقم دا ليصبح [ 3800.00 ] فى مربع لوحده والــ [ 00 ] فى مربع اخر

او الرقم الثانى بتاع مثلا اللى هو ( 3500.50 ) يبقى[ 3500 ] فى مربع و الــ [ 50 ] فى مربع اخر

يعنى الرقم الصحيح فى مربع ولو فى رقم بعد العلامة العشرية يبقى فى مربع لوحده

ولو الرقم صحيح من غير علامة عشرية يبقى الخانة الثانية اللى بعد الرقم عبارة عن 00

اعتقد ان الصعيده كدا ملهمش دعوه بالموضوع 😂

كده تماما والله علشان انا صعيدى فكرتك عاوز تفصل كل رقم لوحده قلت فى عقل بالى العايط ع الفايت نادم هو اللى عاوز كده والارقام هتدخل فى بعض هيفرق منين الارقام الصحيحه من الكسور هههههههههههههههه  شغل صعايده صعايده اومااااااااااااااال

لكن انت كده سسهلتها خالص شوفت العقل زينه والله الله يفتح عليك

ابشر ان شاء الله

 

---------------------------------------

2 ساعات مضت, Lotfy14 said:

ثالثا : الترتيب طبعا بيبقى داخل التقرير

انا مش هشتغل على فورم والمفروض ميبقاش على فور

دا بيبقى عباره عن بوتن اقوله فيما معناه اطبعلى كل الناس المؤمن عليهم من غير ما ادخل فى اعداد تقرير

هو التقرير بيحضر نفسة بنفسة لما اختار من البوتن المؤمنين عليهم ذى ما قلت

وبيبقى الترتيب حسب الرقم التامين بس مش بتاريخ ميلاد ولا تاريخ تعيين ولا رقم قومى

اشتغل على الرقم التامينى

ما هو لو انت تعبت نفسك حبتين وكلفت خاطرك وفتحت التقرير هتلاقى حقل الرقم التأمينى لازم يكون موجود ضمن مصدر البيانات يعندى تقدر تعمل الفرز و الترتيب من خلاله دى اصلا موجوده ومحلوله من نفسها من قبل السؤال 

 

---------------------------------------

2 ساعات مضت, Lotfy14 said:

عارف انك عبقرى ودى بجد اقسم بالله

خدعوك فقالوا

صدقنى والله هى ماشيه ببركة ربنا 

ودليل العبقريه حكيتهولك من شويه وانا بأفكر لك فى فصل الرقم بتاع المبلغ الخاص بالسداد انا راضى ضميرك انت شوفت عبقريه كده فى الدنيا 

 

---------------------------------------

2 ساعات مضت, Lotfy14 said:

حبيبى انا تعبك معايا واكيد الواحد بيتعلم منك ومن كل واحد بالمنتدى ومن غير المنتدى واللى فيه

مكنتش وصلت لحاجة فى شغلى بفضلكم بعد ربنا سبحانه وتعاله

تعب ايه بس انا ما قدمت اى شئ كل ذلك من فضل الله سبحانه وتعالى اولا ثم فضل اساتذتنا العظماء الذين ادين لهم بهذا الفضل واتعلم منهم وعلى اياديهم نسأل الله تعالى ان يبارك لنا فيهم ويبارك لهم فى اعمارهم واعمالهم ويكتب كل ذلك فى موازين اعمالهم ان شاء الله و أن يحسن اليهم كما يحسنون الى كل طلاب العلم

و إعلم وتيقن أن ما أخطئك لم يكن ليصيبك وما أصابك لم يكن ليخطئك وهذا رزق الله سبحانه وتعالى ياتى فى وقته ويكون فى مضمونه من فضله سبحانه وتعالى 

سبحانك لا علم لنا الا ما علمتنا إنك انت الحكيم العليم و الحمد لله تعالى الذى تتم بنعمته الصالحات  و يارب لك الحمد حمداً كثيرا طيبا طاهر مباركا في يارب لك الحمد كما ينبغى لجلال وجهك و لعظيم سلطانك على كل نعمك التى تمن و تنعم بها علينها من واسع فضلك العظيم

[ابو جودي]

في 13‏/3‏/2025 at 13:37, Lotfy14 said:

فنان ابدع وورينا افكارك

 

طيب ع العموم اتفضل دى التعديلات النهائيه بكل اللى طلبته

تم تعديل واضافة الدوال اللازمة داخل الوحدة النمطية 

الكود النهائى والاخيـــــــــر

Option Compare Database
Option Explicit

' متغير عام لتخزين بيانات الحقول المستخدمة في آخر استعلام SQL
Private StoredFieldsInfo As Variant

' التحقق مما إذا كانت السلسلة تحتوي على أرقام فقط
Public Function IsNumericOnly(ByVal InputString As String, Optional AllowDecimal As Boolean = False, Optional AllowNegative As Boolean = False) As Boolean
    On Error Resume Next
    Dim CleanString As String
    CleanString = Trim(InputString)
    If CleanString = "" Or Not IsNumeric(CleanString) Then Exit Function
    If Not AllowDecimal And InStr(CleanString, ".") > 0 Then Exit Function
    If Not AllowNegative And Left(CleanString, 1) = "-" Then Exit Function
    If InStr(CleanString, " ") > 0 Then Exit Function
    IsNumericOnly = True
End Function

' التحقق من صحة الإدخال الرقمي مع حد أقصى للطول
Private Function ValidateNumericInput(InputValue As Variant, ByRef ErrorMessage As String, Optional MaxLength As Integer = 0, Optional AllowDecimal As Boolean = False) As String
    On Error Resume Next
    If IsEmpty(InputValue) Or IsNull(InputValue) Or Len(Trim(InputValue)) = 0 Then
        ValidateNumericInput = ""
        Exit Function
    End If
    
    Dim InputStr As String
    InputStr = CStr(InputValue)
    If Not IsNumericOnly(InputStr, AllowDecimal) Then
        ErrorMessage = "يرجى إدخال أرقام فقط" & IIf(AllowDecimal, " (يمكن أن تحتوي على فاصلة عشرية)!", "!")
        Exit Function
    End If
    
    If MaxLength > 0 And Len(InputStr) > MaxLength Then
        ErrorMessage = "الإدخال يتجاوز الحد الأقصى (" & MaxLength & " أرقام)!"
        Exit Function
    End If
    
    ValidateNumericInput = InputStr
End Function

' توزيع الأرقام داخل مربعات النصوص
Private Sub DistributeDigits(TextBoxCollection As Collection, NumericString As String)
    ' التحقق من أن الإدخال الرقمي ليس فارغًا
    If Trim(NumericString & "") = "" Then
        Dim i As Integer
        For i = 1 To TextBoxCollection.Count
            TextBoxCollection(i).Value = ""
        Next i
        Exit Sub
    End If


    For i = 1 To TextBoxCollection.Count
        If i <= Len(NumericString) Then
            TextBoxCollection(i).Value = Mid(NumericString, i, 1)
        Else
            TextBoxCollection(i).Value = ""
        End If
    Next i
End Sub

' توزيع الأرقام العشرية (الجزء الصحيح والعشري)
Private Sub DistributeDecimal(TextBoxCollection As Collection, NumericString As String)
    On Error Resume Next

    ' التحقق من أن الإدخال الرقمي ليس فارغًا
    If Trim(NumericString & "") = "" Then
        Dim i As Integer
        For i = 1 To TextBoxCollection.Count
            TextBoxCollection(i).Value = ""
        Next i
        Exit Sub
    End If

    Dim parts() As String
    parts = Split(NumericString, ".")
    If TextBoxCollection.Count >= 1 Then TextBoxCollection(1).Value = Nz(parts(0), "") ' الجزء الصحيح
    If TextBoxCollection.Count >= 2 Then TextBoxCollection(2).Value = Nz(parts(1), "00") ' الجزء العشري (افتراضي 00)
End Sub

' جمع مربعات النصوص
Private Function CollectTextBoxes(TargetObject As Object, ControlPrefix As String, MaxFields As Integer) As Collection
    Dim i As Integer, ctrl As Control
    Set CollectTextBoxes = New Collection
    For i = 1 To MaxFields
        On Error Resume Next
        Set ctrl = TargetObject.Controls(ControlPrefix & i)
        If Not ctrl Is Nothing Then CollectTextBoxes.Add ctrl
        On Error GoTo 0
    Next i
End Function

' توزيع الإدخال الرقمي على مربعات النصوص مع خيار فصل الأرقام العشرية
Public Sub DistributeNumericInput(Optional TargetObject As Object = Nothing, Optional InputValue As Variant, _
                                  Optional ControlPrefix As String = "", Optional MaxFields As Integer = 0, _
                                  Optional SplitDecimal As Boolean = False)
    On Error GoTo ErrorHandler

    ' التحقق من القيم الفارغة
    If IsEmpty(InputValue) Or IsNull(InputValue) Or Trim(InputValue & "") = "" Then
        ' إعادة تهيئة مربعات النصوص إلى فارغة
        Dim TextBoxes As Collection
        Set TextBoxes = CollectTextBoxes(TargetObject, ControlPrefix, MaxFields)
        Dim i As Integer
        For i = 1 To TextBoxes.Count
            TextBoxes(i).Value = ""
        Next i
        Exit Sub
    End If

    Dim ValidInput As String, ErrorMessage As String
    ValidInput = ValidateNumericInput(InputValue, ErrorMessage, MaxFields, SplitDecimal)

    If ValidInput = "" Then
        If ErrorMessage <> "" Then MsgBox ErrorMessage, vbExclamation, "خطأ في الإدخال"
        Exit Sub
    End If

    If MaxFields = 0 Then MaxFields = IIf(SplitDecimal, 2, Len(ValidInput))
    If TargetObject Is Nothing Then
        Debug.Print "الإدخال الموزع: " & ValidInput
        Exit Sub
    End If

    Set TextBoxes = CollectTextBoxes(TargetObject, ControlPrefix, MaxFields)

    If SplitDecimal Then
        If TextBoxes.Count < 2 Then
            MsgBox "عدد مربعات النصوص (" & TextBoxes.Count & ") أقل من المطلوب (2) للأرقام العشرية!", vbExclamation, "خطأ"
            Exit Sub
        End If
        DistributeDecimal TextBoxes, ValidInput
    Else
        If TextBoxes.Count < Len(ValidInput) Then
            MsgBox "عدد مربعات النصوص (" & TextBoxes.Count & ") أقل من طول الإدخال (" & Len(ValidInput) & ")!", vbExclamation, "خطأ"
            Exit Sub
        End If
        DistributeDigits TextBoxes, ValidInput
    End If

    Exit Sub
ErrorHandler:
    MsgBox "خطأ في توزيع الإدخال: " & Err.Description, vbCritical, "خطأ"
End Sub

' التحقق من صحة الرقم القومي
Private Function ValidateNationalID(NationalID As Variant, ByRef ErrorMessage As String) As String
    On Error Resume Next
    Dim InputStr As String
    InputStr = Trim(Nz(NationalID, ""))
    If InputStr = "" Or Not IsNumericOnly(InputStr) Or Len(InputStr) <> 14 Then
        ErrorMessage = "يجب إدخال رقم قومي صحيح مكون من 14 رقمًا!"
        Exit Function
    End If
    ValidateNationalID = InputStr
End Function

' استخراج تاريخ الميلاد من الرقم القومي بصيغة YYYY-MM-DD
Public Function ExtractBirthDateFromID(NationalID As Variant) As String
    On Error GoTo ErrorHandler
    Dim ValidInput As String, YearPart As String, MonthPart As String, DayPart As String, CenturyCode As String, ErrorMessage As String
    
    ValidInput = ValidateNationalID(NationalID, ErrorMessage)
    If ValidInput = "" Then
        ExtractBirthDateFromID = "خطأ: " & ErrorMessage
        Exit Function
    End If
    
    CenturyCode = Mid(ValidInput, 1, 1)
    YearPart = Mid(ValidInput, 2, 2)
    MonthPart = Mid(ValidInput, 4, 2)
    DayPart = Mid(ValidInput, 6, 2)
    
    Select Case CenturyCode
        Case "2": YearPart = "19" & YearPart
        Case "3": YearPart = "20" & YearPart
        Case "4": YearPart = "21" & YearPart
        Case Else:
            ExtractBirthDateFromID = "خطأ: رمز القرن غير صالح!"
            Exit Function
    End Select
    
    If Not IsDate(YearPart & "/" & MonthPart & "/" & DayPart) Then
        ExtractBirthDateFromID = "خطأ: تاريخ ميلاد غير صالح!"
        Exit Function
    End If
    
    If CDate(YearPart & "-" & MonthPart & "-" & DayPart) > Date Then
        ExtractBirthDateFromID = "خطأ: تاريخ الميلاد في المستقبل!"
        Exit Function
    End If
    
    ExtractBirthDateFromID = YearPart & "-" & MonthPart & "-" & DayPart
    Exit Function

ErrorHandler:
    ExtractBirthDateFromID = "خطأ: " & Err.Description
End Function

' توزيع تاريخ الميلاد في 3 مربعات نص (السنة - الشهر - اليوم)
Public Sub DistributeBirthDateFromID(Optional TargetObject As Object = Nothing, Optional NationalID As Variant, Optional ControlPrefix As String = "")
    On Error GoTo ErrorHandler
    Dim BirthDate As String, TextBoxes As Collection
    
    BirthDate = ExtractBirthDateFromID(NationalID)
    If Left(BirthDate, 5) = "خطأ" Then
        MsgBox BirthDate, vbExclamation, "خطأ في الرقم القومي"
        Exit Sub
    End If
    
    If TargetObject Is Nothing Then
        Debug.Print "السنة: " & Left(BirthDate, 4)
        Debug.Print "الشهر: " & Mid(BirthDate, 6, 2)
        Debug.Print "اليوم: " & Right(BirthDate, 2)
        Exit Sub
    End If
    
    Set TextBoxes = CollectTextBoxes(TargetObject, ControlPrefix, 3)
    If TextBoxes.Count < 3 Then
        MsgBox "عدد مربعات النص غير كافٍ! (مطلوب 3)", vbExclamation, "خطأ"
        Exit Sub
    End If
    
    TextBoxes(1).Value = Left(BirthDate, 4)
    TextBoxes(2).Value = Mid(BirthDate, 6, 2)
    TextBoxes(3).Value = Right(BirthDate, 2)
    Exit Sub

ErrorHandler:
    MsgBox "خطأ في توزيع تاريخ الميلاد: " & Err.Description, vbCritical, "خطأ"
End Sub

' دالة اختبار لطباعة تاريخ الميلاد
Public Sub TestPrintDistributeBirthDate(NationalID As Variant)
    Dim BirthDate As String
    BirthDate = ExtractBirthDateFromID(NationalID)
    
    If Left(BirthDate, 5) = "خطأ" Then
        Debug.Print BirthDate
    Else
        Debug.Print "تجربة الطباعة للرقم القومي: " & NationalID
        Debug.Print "تاريخ الميلاد: " & BirthDate
    End If
End Sub

' إنشاء استعلام SQL ديناميكي
Public Function GenerateDynamicSQL(tableName As String, ParamArray RequiredFieldsDistribute() As Variant) As String
    On Error GoTo ErrorHandler
    Dim sqlQuery As String, i As Integer, j As Integer, fieldName As String, MaxDigits As Integer, fieldPrefix As String
    
    If Trim(tableName) = "" Or UBound(RequiredFieldsDistribute) < 0 Then
        GenerateDynamicSQL = "خطأ: الجدول أو الحقول غير محددة"
        Exit Function
    End If
    
    StoredFieldsInfo = RequiredFieldsDistribute
    sqlQuery = "SELECT " & tableName & ".*, "
    
    For i = LBound(RequiredFieldsDistribute) To UBound(RequiredFieldsDistribute)
        fieldName = RequiredFieldsDistribute(i)(0)
        MaxDigits = RequiredFieldsDistribute(i)(1)
        fieldPrefix = RequiredFieldsDistribute(i)(2)
        
        For j = 1 To MaxDigits
            sqlQuery = sqlQuery & "IIf(IsNull([" & fieldName & "]) OR Len([" & fieldName & "]) < " & j & ", Null, Mid([" & fieldName & "], " & j & ", 1)) AS " & fieldPrefix & j & ", "
        Next j
    Next i
    
    sqlQuery = Left(sqlQuery, Len(sqlQuery) - 2) & " FROM " & tableName & ";"
    GenerateDynamicSQL = sqlQuery
    Exit Function

ErrorHandler:
    GenerateDynamicSQL = "خطأ: " & Err.Description
End Function

' حذف مصادر البيانات من الحقول غير المستخدمة
Public Sub ClearUnusedTextBoxes(frm As Form)
    On Error GoTo ErrorHandler
    Dim ctl As Control, i As Integer, Prefix As String, MaxDigits As Integer
    
    If IsEmpty(StoredFieldsInfo) Or Not IsArray(StoredFieldsInfo) Then Exit Sub
    
    For i = LBound(StoredFieldsInfo) To UBound(StoredFieldsInfo)
        Prefix = StoredFieldsInfo(i)(2)
        MaxDigits = StoredFieldsInfo(i)(1)
        For Each ctl In frm.Controls
            If TypeName(ctl) = "TextBox" And ctl.Name Like Prefix & "*" Then
                Dim num As Integer
                num = Val(Mid(ctl.Name, Len(Prefix) + 1))
                If num > MaxDigits Then ctl.ControlSource = ""
            End If
        Next ctl
    Next i
    Exit Sub

ErrorHandler:
    Debug.Print "خطأ في ClearUnusedTextBoxes: " & Err.Description
End Sub

' استخراج أجزاء التاريخ (سنة، شهر، يوم) من تاريخ مدخل
Public Function ExtractDateParts(ByVal InputDate As Variant, ByRef ErrorMessage As String) As Variant
    On Error GoTo ErrorHandler
    Dim DateParts(1 To 3) As String
    Dim TempDate As Date
    
    ' تهيئة المصفوفة بقيم افتراضية فارغة
    DateParts(1) = ""
    DateParts(2) = ""
    DateParts(3) = ""
    
    ' حالة الحقل الفارغ
    If IsEmpty(InputDate) Or IsNull(InputDate) Or Trim(InputDate & "") = "" Then
        ExtractDateParts = DateParts ' إرجاع أجزاء فارغة
        Exit Function
    End If
    
    ' حالة الإدخال غير الصحيح
    If Not IsDate(InputDate) Then
        ErrorMessage = "تنسيق التاريخ غير صحيح!"
        Exit Function
    End If
    
    ' تحويل إلى تاريخ
    TempDate = CDate(InputDate)
    
    ' (اختياري) التحقق من أن التاريخ ليس في المستقبل
    ' If TempDate > Date Then
    '    ErrorMessage = "التاريخ لا يمكن أن يكون في المستقبل!"
    '    Exit Function
    ' End If
    
    ' تعبئة الأجزاء بتنسيق صحيح
    DateParts(1) = Format(Year(TempDate), "0000")
    DateParts(2) = Format(Month(TempDate), "00")
    DateParts(3) = Format(Day(TempDate), "00")
    
    ExtractDateParts = DateParts
    Exit Function

ErrorHandler:
    ErrorMessage = "خطأ غير متوقع: " & Err.Description
    ExtractDateParts = Array("", "", "") ' إرجاع قيم فارغة مع رسالة خطأ
End Function

' توزيع أجزاء التاريخ على مربعات النصوص
Public Sub DistributeDateParts(Optional TargetObject As Object = Nothing, Optional InputDate As Variant, _
                              Optional ControlPrefix As String = "DatePart")
    On Error GoTo ErrorHandler
    Dim DateParts As Variant, TextBoxes As Collection
    Dim ErrorMessage As String
    
    DateParts = ExtractDateParts(InputDate, ErrorMessage)
    
    If Not IsArray(DateParts) Then
        MsgBox ErrorMessage, vbExclamation, "خطأ في التاريخ"
        Exit Sub
    End If
    
    If TargetObject Is Nothing Then
        Debug.Print "السنة: " & DateParts(1)
        Debug.Print "الشهر: " & DateParts(2)
        Debug.Print "اليوم: " & DateParts(3)
        Exit Sub
    End If
    
    Set TextBoxes = CollectTextBoxes(TargetObject, ControlPrefix, 3)
    
    If TextBoxes.Count < 3 Then
        MsgBox "يجب توفير 3 مربعات نصية للتوزيع!", vbExclamation, "خطأ"
        Exit Sub
    End If
    
    TextBoxes(1).Value = DateParts(1) ' السنة
    TextBoxes(2).Value = DateParts(2) ' الشهر
    TextBoxes(3).Value = DateParts(3) ' اليوم
    Exit Sub

ErrorHandler:
    MsgBox "خطأ في التوزيع: " & Err.Description, vbCritical, "خطأ"
End Sub

' دالة اختبار  باستخدام DateSerial
Public Sub TestPrintDistributeDate()
    Dim InputDate As Date
    Dim parts As Variant
    Dim ErrorMessage As String
    
    ' إنشاء التاريخ باستخدام DateSerial لتجنب الغموض
    InputDate = DateSerial(2025, 5, 9) ' 9 May 2025 (السنة، الشهر، اليوم)
    
    parts = ExtractDateParts(InputDate, ErrorMessage)
    
    If IsArray(parts) Then
        Debug.Print "السنة: " & parts(1) ' 2025
        Debug.Print "الشهر: " & parts(2) ' 05
        Debug.Print "اليوم: " & parts(3) ' 09
    Else
        Debug.Print "خطأ: " & ErrorMessage
    End If
End Sub

 

فصل وتوزيع ارقام الرقم القومى 3.accdb