دالة دالة استخراج اسم ولي الامر كاملا او الاسم الاول مفردا

[عبدالله باقشير]

السلام عليكم
 

دالة استخراج اسم ولي الامر كاملا او الاسم الاول مفردا

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

خبور خير

استخراج اسم ولي الامر كاملا او الاسم الاول مفردا.rar

[محمدي عبد السميع]

ماشاء الله

هذا هو عالمنا الطيب خبور خير

يتحفنا بهذه الدالة الذكيه

حفظك الله ورعاك

[ياسر خليل أبو البراء]

بوركت يا عالمنا الكبير

مش عارف من غيرك كنا وصلنا لفين ؟أكيد كنا لسه ورا قوي

جزاك الله عنا كل خير

والله إنس لأستفيد من إبداعاتك المستمرة أنا وغيري فسر على الدرب أخي الغالي

[شامل2]

السلام عليكم

بارك اله فيك اخي العزيز

ورمضان كريم

[عبد الفتاح كيرة]

جزاك الله عنا خيرا أستاذنا الفاضل

[khalleefa2008]

[inas aly]

جزاك الله عنا خيرا أستاذنا الفاضل

[أبو محمد أشرف]

أنت رائع حقا أستاذنا الكبير خبور الخير

[ياسر الحافظ]

استاذنا عبد الله " خبور خير " :

والله روعة

تسلم

وفقك الله

ياسر الحافظ

[منتصر الانسي]

الأخوة الأعزاء

الحقيقة الواحد يدخل على منتدى أكسيل وهو مرعوب من العمالقة اللي فيه

اسمحوا لي اخواني بهذا التعديل البسيط حيث قمت بعمل (توليفة) بين دالة تم إعدادها بأكسس بدالة الأستاذ خبور

بحيث يصبح بالإمكان إستخراج أي جزء مطلوب من الإسم

أرجو أن أكون موفقاً في هذه (التوليفة)

تحياتي,,,

تجزئة الأسماء.rar

[عبدالله المجرب]

الأخوة الأعزاء

الحقيقة الواحد يدخل على منتدى أكسيل وهو مرعوب من العمالقة اللي فيه

أرجو أن أكون موفقاً في هذه (التوليفة)

مرحباً بك يا ابا ناصر (عملاق من عمالقة الاكسس والاكسل معاً)ويتشرف قسم الاكسل باطلالتك البهية عليه

والتوليفة (المعادلة) روووووعة جداً يا ابا ناصر سلمت يمينك

ابواحمد

[منتصر الانسي]

مشكور اخي ابو احمد على الكلام الطيب

الموضوع ليس فيه اي عملقة ولا شيئ ولكن هذا مايثبت ان اي دوال تصمم في اكسس يمكن تنفيذها في اكسل وحتى وورد (والعكس صحيح) فجميعها تعمل في بيئة واحدة هي بيئة(VBA)ولكن الصعوبة التي واجهتني كانت انه يتم اخذ الاستثناءات الخاصة بالأسماء كـ(عبد , الله , الدين , ....الخ) من جدول في قاعدة البيانات ولم أكن أعرف طريقة التنفيذ في اكسل

فقد كان أفكر ان أجعلها في ورقة مستقلة بحيث يتم أخذها من هذه الورقة وبصراحة فأنا أجهل كيفية التعامل مع اوراق العمل والخلايا في اكسل

ولكن الأستاذ خبور (وهو العملاق الحقيقي) قد تجاوزها بواسطة إستخدامه المصفوفة ومن هنا تم عمل التوليفة

في الأخير لدي استفسار هل هناك إمكانية لتنفيذ هذه الطريقة (ان يتم وضع الإستثناءات في ورقة مستقلة) لمنح حرية اكبر للمستخدم...؟

تحياتي,,,

[a12]

بارك الله فيكم

ممكن طريقة بدون اكواد

وشكراص

[يوسف عطا]

بارك الله فيكم

[naderwatfa]

بارك الله فيكم جميعاً و شكر لكم جهودكم

[abdelmoneeim]

بارك الله فيكم