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

[ابو جودي]

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

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

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

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

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

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

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

اولا : وحدة نمطيه عامة باسم : 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