اضافة بسيطة على كود فصل اسم الاب عن اسم الابن المركب

[عمر الجزاوى]

السلام عليكم ورحمة الله وبركاته بعد اذن استاذتنا الكرام بعد البحث في المنتدى وجدت هذا الكود للعلامة الأستاذ عبدالله بقشير ويقوم الكود بفص اسم الاب عن اسم التلميذ وان كان الاسم مركب  وعند تجربة الكود يقوم بفصل اسم الاب عن اسم التلميذ وهو اسم مركب الا في حالاتين وهو اسم نور الهدى واسم فاطمة الزهراء وهما اسمين مركبين المفروض ياخذ من بداية اسم احمد محمد عبدالرؤوف ام باقى الاسماء فهم تمام المطلوب اضافة اسم الهدى واضافة اسم الزهراء الى الكود وجزاكم الله خير

استخراج اسم الاب من الاسم المركب.xlsm

[محمد هشام.]

وعليكم السلام ورحمة الله تعالى وبركاته 

جرب هدا 

Function Father_Name(Name As Variant, Optional x As Variant) As Variant
    Dim tmp As String, s As String, n As Integer, d As Integer, j As Integer
    
    tmp = Trim(Name.Value)
    j = Len(tmp)
    s = " "
    
    If InStr(1, tmp, s) = 0 Then
        Father_Name = ""
        Exit Function
    End If

    Select Case True
        Case Left(tmp, 9) = "نور الهدى"
            n = InStr(10, tmp, s) + 1
            Father_Name = Mid(tmp, n, j)
            Exit Function
            
        Case Left(tmp, 13) = "فاطمة الزهراء"
            n = InStr(14, tmp, s) + 1
            Father_Name = Mid(tmp, n, j)
            Exit Function
    End Select

    If Not IsError(x) Then
        n = 1
        For r = 2 To x
            n = InStr(n, tmp, s) + 1
        Next r
        d = InStr(n, tmp, s) + 1
        Father_Name = Mid(tmp, d, j)
    Else
        n = InStr(1, tmp, s) + 1
        d = InStr(n, tmp, s) + 1
        
        If Mid(tmp, 1, 3) Like "عبد*" Or Mid(tmp, 1, 3) Like "أبو*" Or _
           Mid(tmp, n, 5) Like "الله" Or Mid(tmp, n, 5) Like "الدين" Then
            Father_Name = Mid(tmp, d, j)
        Else
            Father_Name = Mid(tmp, n, j)
        End If
    End If
End Function

 

استخراج اسم الاب من الاسم المركب.xlsm

[عمر الجزاوى]

استاذنا انا عايز ندخل التعديل على هذا النطاق 

   If Mid(K, 1, 4) = "عبد " Or _
      Mid(K, 1, 4) = "أبو " Or _
      Mid(K, 1, 4) = "ابو " Or _
      Mid(K, N, 5) = "الله " Or _
      Mid(K, N, 6) = "الدين " Then

مع العلم اسم الهدى ممكن يجى مع اسماء تانية مثل سيف الهدى فيه فاطمة تكتب بالتاء المربوطه واخرى تكتب فاطمه بالهاء 

انا اسف على الازعاج

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

بعد اذن استاذنا الفاضل محمد هشام 

كذلك كود الاستاذ العلامة  عبدالله باقشيرلا يتعامل مع  اسماء اخرى مثل المعتصم بالله    الواثق بالله ام كلثوم   ام احمد  ام الخير ام الهناء واحيانا بالهمز واحيانا لا  وغيرها من الاسماء  

والقاعدة هي اظافة الاسم الثابت بمعنى  مثلا فاطمة الزهراء فنضيف الى الكود الزهراء فقط لانه ثابت واي اسم ياتي قبل الزهراء سيتعامل معه الكود  كذلك نور الهدى او سيف الهدى فنضيف الى الكود اسم الهدى فقط وهكذا

كذلك يمكنك اظافة اي اسم اد جد اسم جديد

تعديل الكود

Function Father_Name(Name As String, Optional x As Integer = 2) As String
    Dim K As String
    Dim S As String
    Dim N As Integer
    Dim d As Integer
    Dim M As Integer
    Dim r As Integer
    
    K = Trim(Name)
    M = Len(K)
    S = " "
    
    If InStr(1, K, S, 1) = 0 Then
        Father_Name = ""
        Exit Function
    End If
    
    If x > 1 Then
        N = 1
        For r = 2 To x
            d = InStr(N, K, S, 1) + 1
            If d = 1 Then
                Father_Name = ""
                Exit Function
            End If
            N = d
        Next
        d = InStr(N, K, S, 1) + 1
        If d = 1 Then
            Father_Name = ""
            Exit Function
        End If
        Father_Name = Mid(K, d, M)
    Else
        N = InStr(1, K, S, 1) + 1
        d = InStr(N, K, S, 1) + 1
        If d = 1 Then
            Father_Name = ""
            Exit Function
        End If
        If Mid(K, 1, 4) = "عبد " Or _
           Mid(K, 1, 4) = "أبو " Or _
           Mid(K, 1, 4) = "ابو " Or _
           Mid(K, N, 5) = "الله " Or _
           Mid(K, N, 6) = "الدين " Or _
           Mid(K, 1, 5) = "الهدى " Or _
           Mid(K, 1, 6) = "كلثوم " Or _
           Mid(K, 1, 7) = "الزهراء " Or _
           Mid(K, 1, 3) = "أم " Or _
           Mid(K, 1, 2) = "ام " Or _
           Mid(K, N, 5) = "بالله " Then
            Father_Name = Mid(K, d, M)
        Else
            Father_Name = Mid(K, N, M)
        End If
    End If
End Function

الملف

استخراج اسم الاب من الاسم المركب1.xlsm

[عمر الجزاوى]

شكرا استاذ عبدالله وشكرا استاذ محمد هشام على تعبكم 

هو ده المطلوب استاذ عبدالله

جزاكم الله خيرا انت والاستاذ محمد هشام 

وجعله الله فى ميززان حسناتكم