الأخوة الكرام
السلام عليكم ورحمة الله وبركاته
أقدم لكم دالة معرفة لفصل اسم الأب كاملاً عن اسم الابن
---------------------------------------------
يوضع الكود التالى فى موديول عادى
--------------------------------------------CODE
Function Kh_Father_Name(ByVal Name As String, Optional kh_First As Boolean) As String
Dim KhString As String, Kh_Mid As String, Kh_Rep As String
Dim KhMyNo As Integer
On Error GoTo Err_Kh_Father_Name
If IsEmpty(Name) Then GoTo Err_Kh_Father_Name
KhString = Kh_Father_Replace(Trim(Name)) & " "
KhMyNo = InStr(1, KhString, " ", 1)
If kh_First Then Kh_Mid = Trim(Mid(KhString, 1, KhMyNo)) Else _
Kh_Mid = Trim(Mid(KhString, KhMyNo, Len(KhString)))
Kh_Rep = Replace(Kh_Mid, "^", " ")
Kh_Father_Name = Kh_Rep
Exit Function
Err_Kh_Father_Name:
Kh_Father_Name = ""
End Function
Private Function Kh_Father_Replace(ByVal Kh_Sub As String) As String
Dim MyArray, Ar
Dim Sn As String, Re As String
'====================================================
' يمكنك اضافة اي معيار آخر هنا بجانب المعايير الموجودة
MyArray = Array("عبد ", "أبو ", "ابو ", "آل ", " الله" _
, " الدين", " الإسلام", " الاسلام", " الحق")
'====================================================
Sn = Kh_Sub
For Each Ar In MyArray
Re = Replace(Ar, " ", "^")
Sn = Replace(Sn, Ar, Re)
Next
Kh_Father_Replace = Sn
End Function
ثم نضع الدالة التالية فى فى الخلية المراد فصل الاسم بها
مثال : فإذا كان الاسم كاملا موجود بالخلية C8 مثلا ، توضع الدالة التالية فى الخلية D8
CODE
=Kh_Father_Name(C8)<br />
فصل اسم الأب كاملا عن اسم الابن.rar
تقبلوا تحياتى