الأستاذ البطل السيناوى
عندما كتبت اسم
نور الدين يحيى
جاءت النتيجة
الدين يحيى
و هذا طبعا خطأ
الحاصل أن مثل هذا الهدف
لايمكن الحصول عليه بمعادلة
لكن هناك دالة مخصصة
من ابتكار أخى و معلمى الأستاذ خبور
تكفلت ب 99 فى المئة من النتائج الصحيحة
و هذا هو الكود العبقرى الخاص بها
كود:
Option Explicit
' بسم الله الرحمن الرحيم "
' ******************** "
' دالة استخراج اسم ولي الأمر "
'========================================"
' True = kh_First اذا كان "
' او اي رقم غير الصفر "
' تقوم باستخراج الاسم الاول "
'========================================"
' يامكانية معالجة الاسم المركب الاول "
' تلقائياً حسب معايير معرفة لديها "
' Kh_Father_Replace في الدالة "
' ويمكنك اضافة اي معيار آخر "
' بجانب المعايير الموجودة "
' MyArray في المتغير "
' مع مراعاة وجود فراغ بداية
' او نهاية المعيار
'========================================"
'-----------------------------------------------------------------
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
الملف بالمرفقات