اذهب الي المحتوي
أوفيسنا
بحث مخصص من جوجل فى أوفيسنا
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...
  • 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 بدون حفظ بسبب خطأ فى تطبيق الكود

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

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

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.

زائر
اضف رد علي هذا الموضوع....

×   Pasted as rich text.   Paste as plain text instead

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

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

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

Important Information