لنفرض أن لديك مربع نص الذى سوف تضع فيه الرقم القومى وليكن أسمه : National_Nr
، مربع نص سوف يأخذ معلوماته فى النوع من السابق وليكن أسمه : gender
، مربع نص ثالث سوف يأخذ معلوماته فى المحافظة وليكن أسمه : Mohaftha
، مربع نص رابع سوف يستقطع تاريخ الميلاد وليكن أسمه : birth
من مربع النص National_Nr فى خاصية حدث بعد التحديث أنسخ الكود التالى:-
Private Sub National_Nr_AfterUpdate()
Dim x, y, z, r As Byte
Dim xx As String * 2
Dim MyProvinces As Variant
x = Left(Me.National_Nr, 1)
If x = 2 Then
Me.birth.Value = Mid(Me.National_Nr, 2, 2) & "-" & Mid(Me.National_Nr, 4, 2) & "-" & Mid(Me.National_Nr, 6, 2)
Else
Me.birth.Value = 20 & Mid(Me.National_Nr, 2, 2) & "-" & Mid(Me.National_Nr, 4, 2) & "-" & Mid(Me.National_Nr, 6, 2)
End If
'=======
y = Left(Right(Me.National_Nr, 2), 1) Mod 2
If y = 1 Then
Me.gender.Value = "ذكر"
Else
Me.gender.Value = "أنثى"
End If
'=======
MyProvinces = Array("01/القاهرة", "02/الإسكندرية", "03/بورسعيد", "04/السويس", "11/دمياط", "12/الدقهلية", "13/الشرقية" _
, "14/القليوبية", "15/كفر الشيخ", "16/الغربية", "17/المنوفية", "18/البحيرة", "31/البحر الأحمر", "32/الوادى الجديد" _
, "19/الإسماعيلية", "21/الجيزة", "22/بني سويف", "23/الفيوم", "24/المنيا", "25/أسيوط", "34/شمال سيناء", "35/جنوب سيناء" _
, "26/سوهاج", "27/قنا", "28/أسوان", "29/الأقصر", "33/مطروح", "88/خارج مسر")
z = Mid(Me.National_Nr, 8, 2)
For r = LBound(MyProvinces) To UBound(MyProvinces)
xx = MyProvinces(r)
If z = xx Then
Me.Mohaftha.Value = Right(MyProvinces(r), Len(MyProvinces(r)) - 3)
Exit For
End If
Next
End Sub
الكود السابق تم أخذه من هنا بالمنتدى ...
الأفضل عمل ملف توضيحي بالمرفقات .. تفضل
db1.rar