لو سمحتم عايزه اكتب الكود التالي في button في ال userform في ال excel
بس مش عارفه إزاي ممكن تساعدوني
' 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®
If x = xx Then
Kh_Date_Sex_Province = Right(MyProvinces®, Len(MyProvinces®) - 3)
Exit For
End If
Next
End If
1:
End Function