اذهب الي المحتوي
أوفيسنا
بحث مخصص من جوجل فى أوفيسنا
Custom Search

دالة استخراج اسم ولي الامر/ بمعيارين


الردود الموصى بها

السلام عليكم

جمعة مباركة

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

==================
'       بسم الله الرحمن الرحيم            "
'======================================"
'     دالة استخراج اسم ولي الأمر         "
'======================================"
'تلقائية الاستخدام : تقوم بإستخراج الاسم "
'   تلقائياً حسب  معايير معرفة لديها     "
'======================================"
'بالإختيار       : تقوم بإستخراج الاسم   "
'   رقما يحدد KhIndex حسب  التعيين في     "
' ( بعد كم  فراغ يستخرج الاسم المطلوب ؟ )"
'======================================"
Function Father_Name(Name As Variant, Optional KhIndex) As Variant
Dim KhString, SearchChar, KhMyNo, KhMyNo1
Dim KhMyLen As Integer
KhString = Trim(Name.Value)
KhMyLen = Len(KhString)
SearchChar = " "
If InStr(1, KhString, SearchChar, 1) = 0 Then Father_Name = "": GoTo 3
If Not IsError(KhIndex) Then
    KhMyNo = 1
    For R = 2 To KhIndex
        KhMyNo1 = InStr(KhMyNo, KhString, SearchChar, 1) + 1
        KhMyNo = KhMyNo1
    Next
    KhMyNo1 = InStr(KhMyNo, KhString, SearchChar, 1) + 1
    Father_Name = Mid(KhString, KhMyNo1, KhMyLen)
Else
    KhMyNo = InStr(1, KhString, SearchChar, 1) + 1
    KhMyNo1 = InStr(KhMyNo, KhString, SearchChar, 1) + 1
   If Mid(KhString, 1, 4) = "عبد " Or _
      Mid(KhString, 1, 4) = "أبو " Or _
      Mid(KhString, 1, 4) = "ابو " Or _
      Mid(KhString, KhMyNo, 5) = "الله " Or _
      Mid(KhString, KhMyNo, 6) = "الدين " Then
      Father_Name = Mid(KhString, KhMyNo1, KhMyLen)
   Else
      Father_Name = Mid(KhString, KhMyNo, KhMyLen)
   End If
End If
3 End Function

fname2.rar

تم تعديل بواسطه خبور خير
  • Like 1
رابط هذا التعليق
شارك

السلام عليكم

اخى خبور انت ابداع X ابداع

بارك الله فيك

* ممكن يكون اسم الاب مثلا عبيد الله بدلا من عبد الله

خذ هذا التركيب في الاعتبار

تم تعديل بواسطه ابو اسامة العينبوسي
رابط هذا التعليق
شارك

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

ممكن يكون اسم الاب مثلا عبيد الله بدلا من عبد الله

هناك اسماء مركبة نادرة ولكنها موجودة ولذلك حلها البطل في تحديد رقم في

KhIndex حسب التعيين

' ( بعد __ كم فراغ يستخرج الاسم المطلوب ؟

رابط هذا التعليق
شارك

السلام عليكم

اخي ابو اسامة --------------------حفظه الله

شكرا جزيلا

* ممكن يكون اسم الاب مثلا عبيد الله بدلا من عبد الله

ممكن تضيف المعيار بمثل المعايير الموجودة في الكود

Mid(KhString, 1, 5) = "عبيد " Or _

====================================

الاخ / قصي --------------------حفظه الله

الاخ / محمدي عبد السميع --------------------حفظه الله

الاخ / masrawy--------------------حفظه الله

الاخ / ايمن --------------------حفظه الله

تقبلوا شكري وتقديري

رابط هذا التعليق
شارك

رائع كعادتك :clapping:

هناك اسماء مركبة نادرة ولكنها موجودة ولذلك حلها البطل في تحديد رقم في

KhIndex حسب التعيين

' ( بعد __ كم فراغ يستخرج الاسم المطلوب ؟

اين اضع الرقم ؟ دلني عليه كرما

رابط هذا التعليق
شارك

السلام عليكم

الاخ ناصر ----------------------حفظه الله

الاسم التالي في الخلية المشار عليها في الدالة : جمال عبد الناصر خبور خير

عند استخدامك الدالة :

=Father_Name(B9;3)

نتيجة الدالة :خبور خير

في المرفق امثله لذلك

fname2.rar

  • Thanks 1
رابط هذا التعليق
شارك

السلام عليكم

هي دي الدالة المطلوبة في البرنامج المدرسي لكم

ضعها لو سمحت في البرنامج

نتعشم في وضعها في مكانها الطبيعي وهو برنامجكم المفضل لدينا -- البرنامج المدرسي --

إن شاء الله

رابط هذا التعليق
شارك

  • 2 weeks later...

اخي الحبيب خبور خير ابو علي

قد يكون هذا الرد متأخرا بعض الشئ الا انه بسب ان الكلمات تعجز عن وصف هذا الابداع

جزاك الله خيرا ووسع لك في رزقك :fff:

اخوك ابو خالد

رابط هذا التعليق
شارك

السلام عليكم

الاخ المبارك ابو خالد ------------- حفظه الله

بارك الله فيك واثابك بدعائك واعطاك بمثله اضعاف مضاعفة

تحياتي وشكري

رابط هذا التعليق
شارك

  • 4 months later...

هذه الدالة تذكرني بدالة قديمة من موقع الفريق العربي .

للفائدة :

Function LaborNameSplit(ByVal InName As String, PartNo As Byte) As String
  Dim FullName As String
  Dim Part As String
  Dim Part2 As String
  Dim LPart As String
  Dim Pos As Byte
  Dim Pos2  As Byte
  Dim K As Integer

  LaborNameSplit = ""
  FullName = Trim(Nz(InName)) & " "
  Do
    Pos = InStr(1, FullName, "  ")
    If Pos > 0 Then FullName = Left(FullName, Pos) & Mid(FullName, Pos + 2)
  Loop Until Pos = 0

  Do
    K = K + 1
    Pos = InStr(1, FullName, " ")
    Part = Left(FullName, Pos)
    Select Case Part
      Case "آل ", "عبد ", "عبدرب ", "Al ", "Abdul "
        Pos = InStr(Pos + 1, FullName, " ")
      Case Else
        Pos2 = InStr(Pos + 1, FullName, " ")
        If Pos2 > 0 Then
          Part2 = Mid(FullName, Pos + 1, Pos2 - Pos)
          Select Case Part2
            Case "الله ", "الحق ", "الإسلام ", "الدين "
              Pos = Pos2
          End Select
        End If
    End Select
   
    If Pos = 0 Then
      If PartNo > 0 Then
        If (K - 1) = PartNo Then LaborNameSplit = ""
      Else
        LaborNameSplit = LPart
      End If
      Exit Function
    End If
   
    If K = PartNo Then LaborNameSplit = Left(FullName, Pos - 1)
    LPart = Left(FullName, Pos - 1)
    FullName = Mid(FullName, Pos + 1, Len(FullName))
  Loop
End Function

تم تعديل بواسطه Accessna
رابط هذا التعليق
شارك

  • 3 weeks later...

الاخ الفاضل خبور خير

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

والله إن سألنا الله عنك يوم القيامة لقلنا فيك كل الخير إنك رجل لا تكتم علماً علمك الله إياه

فعلا أفكارك رائعة ومفيدة

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

وهو موضوع كود الدوائر الحمراء فى برامج الكنترول وأطلب الأتى :-

1- شرحا وافياً عن كيفية الاستفادة من الكود فى شيت الامتحانات أو نتيجة الحائط وكذلك الشهادات .

2- هل يستلزم الكود دالة معينة يجب أن تصحب الكود .

3- عند استخدام الكود يكون الملف ثقيل جدا جدا جدا على الجهاز فيرجى وضع سطر فى الكود بحيق لا تظهر الدائرة الحمراء إذا كانت القيمة = صفر .

4- عند فتح الصفحة تظهر الدوائر تلقائيا وإذا عملت إخفاء الدوائر تختفى وإذا عملت إظهار الدوائر لا تظهر إلا إذا أغلقت الملف وفتحته من جديد ( ياريت تلاقى حل لهذه المشكلة )

5- ياريت يكون الشرح خطوة خطوة حتى نستفيد .

لأنه بصراحة الكود عندى ووضعنه فى الملف وأظهر نتائج ولكنها ليست نتائج صحيحة وكثيرا ما أضطر لإغلاق الملف ctrl + alt + del بدون حفظ بسبب خطأ فى تطبيق الكود

منتظر ردكم وشرحكم حتى نضعه فى مجلد أفكار وحلول الأستاذ / خبور خير .

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

رابط هذا التعليق
شارك

من فضلك سجل دخول لتتمكن من التعليق

ستتمكن من اضافه تعليقات بعد التسجيل



سجل دخولك الان
  • تصفح هذا الموضوع مؤخراً   0 اعضاء متواجدين الان

    • لايوجد اعضاء مسجلون يتصفحون هذه الصفحه
×
×
  • اضف...

Important Information