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

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

السلام عليكم

جمعة مباركة

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

==================
'       بسم الله الرحمن الرحيم            "
'======================================"
'     دالة استخراج اسم ولي الأمر         "
'======================================"
'تلقائية الاستخدام : تقوم بإستخراج الاسم "
'   تلقائياً حسب  معايير معرفة لديها     "
'======================================"
'بالإختيار       : تقوم بإستخراج الاسم   "
'   رقما يحدد 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

تم تعديل أغسطس 1, 2008 بواسطه خبور خير

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

ماشاء الله .. ماشاء الله
دالة ولاأروع عمل ولاأفضل منه
بارك الله لك و لأهلك .. آمين

[ابو اسامة العينبوسي]

السلام عليكم

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

بارك الله فيك

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

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

تم تعديل أغسطس 1, 2008 بواسطه ابو اسامة العينبوسي

[قصي]

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

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

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

KhIndex حسب التعيين

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

[محمد مصراوى]

مبدع دائما

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

ويارت اذا توفر الوقت لديك ان تقوم بشرح المعادلة الخاصة vb للمبتدئبن

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

[ايمن ريا]

رائـع ، وبارك الله فيك

تم تعديل أغسطس 1, 2008 بواسطه aiman raya

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

السلام عليكم

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

شكرا جزيلا

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

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

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

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

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

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

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

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

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

[ناصر سعيد]

رائع كعادتك

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

KhIndex حسب التعيين

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

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

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

السلام عليكم

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

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

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

=Father_Name(B9;3)

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

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

fname2.rar

[cat101]

شكرا

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

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

[ناصر سعيد]

بارك الله فيك

هذه احسن دالة لاسم ولي الامر

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

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

السلام عليكم

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

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

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

إن شاء الله

[نزار سليمان عيد]

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

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

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

اخوك ابو خالد

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

السلام عليكم

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

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

تحياتي وشكري

[Accessna]

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

للفائدة :

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

تم تعديل يناير 1, 2009 بواسطه Accessna

[علي فاهم]

زيادة الخير خيرين

ضعها في ملف ليزداد فهمها

[Accessna]

مثال مرفق

LaborNameSplit.rar

[علي فاهم]

مثال مرفق

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

وغفر الله لكم جميعا

[ابراهيم البقري]

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

للرفع للفائده

[محمد عسكر]

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

أخي / خبور

بارك الله فيك و في ابداعاتك