الرئيسية | مايكروسوفت اوفيس | مايكروسوفت اكسل | استخراج البيانات من الرقم القومي بواسطة اكواد VBA

استخراج البيانات من الرقم القومي بواسطة اكواد VBA


سبق ان استعرضنا في عدة موضوعات كيفية إستخراج البيانات من الرقم القومي مثل تحديد تاريخ الميلاد و محل الميلاد و نوع الفرد(ذكر/انثى)وكذلك تعرفنا كيفية التحكم في إدخال البيانات للخلية بحيث يتم إدخال 14 رقم في خلية الرقم القومي، كل هذه الموضوعات كانت من خلال استخدام المعادلات، لكن اليوم سنتعرف على طريقة جديدة لإستخراج البيانات الثلاثة بدالة واحدة.اليوم سنستعرض معاً إحدى الدوال المستحدثة User Defined Function التي قام بكتابتها الأستاذ / عبدالله باقشير في موضوع دالة استخراج تاريخ الميلاد او النوع او المحافظة من الرقم القومي


النقاط الأساسية بهذا الموضوع

  1. إضافة الكود لملف الإكسل في وحدة نمطية Module جديدة
  2. كيفية الوصول للدالة من خلال مربع الحوار Insert Function
  3. كيفية إستخدام الدالة بمتغيراتها الثلاثة
  4. كيفية إضافة محافظات جديدة في الكود الأصل
  5. حفظ الملف بالإمتداد المناسب


الفيديو التالي يوضح هذه النقاط السابقة

كود دالة إستخراج البيانات من الرقم القومي (تاريخ الميلاد/ نوع الفرد/ محل الميلاد )

Option Explicit
 
'           بسم الله الرحمن الرحيم
'           ********************
'            دالـــــــــــــــة
'           Kh_Date_Sex_Province
'  ( استخراج تاريخ الميلاد او النوع (ذكر - انثى
'       او المحافظة من الرقم القومي
'==============================================
'                  MyTest
'    اذا كانت = 1  تقوم باستخراج تاريخ الميلاد
'          اذا كانت = 2  تقوم باستخراج النوع
'         اذا كانت = 3  تقوم باستخراج المحافظة
'----------------------------------------------
'         MyProvinces  في متغير الجدول
'            العمل لم  يستكمل بعد
'      يمكنك إضافة المحافظات الاخرى الغير موجودة
'          او تعديل الموجود في حالات الخطأ
'   بنفس الطريقة الرقم اولا ثم "/" ثم اسم المحافظة
'                             :  مثال على ذلك
'               "01/القاهرة"
'==============================================
'-----------------------------------------------------------------
 
Function Kh_Date_Sex_Province(MyNumber As Variant, MyTest As Byte)
Dim MyProvinces As Variant
Dim r As Integer
Dim yy As String
Dim ty As String * 1
Dim d As String * 2, m As String * 2, y As String * 2 _
, x As String * 2, xx As String * 2
'==============================================
'       يمكنك إضافة المحافظات الاخرى الغير موجودة
'          او تعديل الموجود في حالات الخطأ
MyProvinces = Array("01/القاهرة", "02/الإسكندرية", "12/الدقهلية", "13/الشرقية" _
, "14/القليوبية", "15/كفر الشيخ", "16/الغربية", "17/المنوفية", "18/البحيرة" _
, "19/الإسماعيلية", "21/الجيزة", "22/بني سويف", "24/المنيا", "25/أسيوط" _
, "26/سوهاج", "27/قنا", "28/أسوان", "29/الأقصر", "33/مطروح")
'==============================================
Kh_Date_Sex_Province = ""
On Error GoTo 1
If Len(Trim(MyNumber)) = 0 Then
    GoTo 1
End If
 
If Not IsNumeric(MyNumber) Or Len(MyNumber) <> 14 Then
    Kh_Date_Sex_Province = "Error_MyNumber"
    GoTo 1
End If
 
If MyTest = 1 Then
    d = Mid(MyNumber, 6, 2)
    m = Mid(MyNumber, 4, 2)
    y = Mid(MyNumber, 2, 2)
    ty = Left(MyNumber, 1)
 
    Select Case ty
        Case "2": yy = y
        Case "3": yy = "20" & y
        Case Else: yy = ""
    End Select
    If yy <> "" Then Kh_Date_Sex_Province = DateSerial(yy, m, d)
 
ElseIf MyTest = 2 Then
    If Left(Right(MyNumber, 2), 1) Mod 2 = 1 Then _
    yy = "ذكر" Else yy = "انثى"
    Kh_Date_Sex_Province = yy
 
ElseIf MyTest = 3 Then
    x = Mid(MyNumber, 8, 2)
    For r = LBound(MyProvinces) To UBound(MyProvinces)
        xx = MyProvinces(r)
        If x = xx Then
            Kh_Date_Sex_Province = Right(MyProvinces(r), Len(MyProvinces(r)) - 3)
            Exit For
        End If
    Next
End If
1:
End Function

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

هذا الموضوع هو احد موضوعات سلسلة الرقم القومي داخل ميكروسوفت إكسل

  1. تحديد نوع البيانات و الحد الأقصى لمحتويات الخلية
  2. تحديد نوع الفرد بواسطة الرقم القومي
  3. تحديد تاريخ الميلاد بواسطة الرقم القومي
  4. تحديد محل الميلاد بإستخدم الرقم القومي المصري
  5. إستخراج البيانات من الرقم القومي بواسطة اكواد VBA

شاهد أيضاً

إختصارات مايكروسوفت اكسل 01

إختصارات الاكسل كثيرة منها ما يتم من خلال لوحة المفاتيح Keyboard ومنها ما يتم من ...