تجزئة الاسم الرباعي الى اربع خانات

[أمجد جمالي]

السلام عليكم

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

هل يوجد كود يقوم بتجزئة هذا الاسم على اربع خانات مثال

Name: محمد

Father: احمد

Grand: عبدالله

Family: احمد

وشكراً

هذه الطريقة شفتها على احد البرامج المبرمجه با الفيجوال بيسك

[أبو هادي]

السلام عليكم

هذه دالة لطلب أي جزء من الإسم حتى لو كان رقم 25 مثلا . أما في حالة طلب الإسم الأخير ولنعتبره اسم العائلة أو القبيلة فنستخدم رقم 0 ( صفر ) :

Function LaborNameSplit(InName As String, PartNo As Byte) As String
  Dim FullName, Part, Part2, LPart As String
  Dim pos, Pos2  As Byte
  Dim K As Integer
  
  LaborNameSplit = ""
  FullName = RTrim(LTrim(Nz(InName))) & " "
  
  Do While True
    K = K + 1
    pos = InStr(1, FullName, " ")
    Part = Left(FullName, pos)
    If Part = "آل " Or Part = "عبد " Or Part = "عبدرب " Or _
       Part = "Al " Or Part = "Abdul " Then
      pos = InStr(pos + 1, FullName, " ")
    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 If
    
    If pos = 0 Then
      Select Case PartNo
        Case Is > 0
          If (K - 1) = PartNo Then
            LaborNameSplit = ""
          End If
        Case Else
          LaborNameSplit = LPart
      End Select
      Exit Function
    End If
    
    Select Case K
      Case PartNo
        LaborNameSplit = Left(FullName, pos - 1)
    End Select
    LPart = Left(FullName, pos - 1)
    FullName = Mid(FullName, pos + 1, Len(FullName))
  Loop
End Function

واستدعاؤها كالتالي :

Me.txtName = LaborNameSplit(Nz(ClientName), 1)
Me.txtFather = LaborNameSplit(Nz(ClientName), 2)
Me.txtGrand = LaborNameSplit(Nz(ClientName), 3)
Me.txtFamily = LaborNameSplit(Nz(ClientName), 0)

تحياتي .

[أمجد جمالي]

الله يعطيك العافية استاذ ابو هادي

مشي الحال

[مغروم]

هل لنا ان نرى هذه الدالة عن طريق مثال ليسهل التطبيق .

[أمجد جمالي]

تفضل اخ مغروم هذا مثال

على دالة الأستاذ ابو هادي

مع تحياتي

Db1.zip

[مغروم]

شكرا اخي syrian_here على تجاوبك السريع

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

تحياتي

[أمجد جمالي]

اهلا وسهلا فيك اخ مغروم واحنا في الخدمة انشاء الله

[جمال فايز]

أخوانى الكرام لزم التنويه على الكلمة المكتوبه وهى انشاء الله فهى كلمة خطأ والكلمة الصحيحة هى إن شاء الله .

أخوانى الكرام يجب مراعاة الكلام الصحيح فى الدين وجزاكم الله خير .

[أمجد جمالي]

الاخ جمال الفايز

اشكرك على هذا التنويه

[سهل احمد العريشي]

بسم الله الرحمن الرحيم

ممكن تكمل الفكره هذي شوفها ورد لي خبر

أخيك سهل احمد ( ابو نعيم )

EXP1.rar

[أمجد جمالي]

الله يعطيك العافية استاذ سهل

عدلت عليها وخلص انحلت المشكلة

وشكراً

[Janna]

كود ممتاز و لا أحلى يا أخي السوري.

[سهل احمد العريشي]

بسم الله الرحمن الرحيم

الحمد لله وكنت واثق أنا بتعدل الكود وبتخليه تمام لأني واثق من قدراتك وأنا على ثقه أنك بتكون مرجع مهم لنا في الأكواد إن شاء الله وتقبل تحياتي

أخيك سهل احمد ( ابو نعيم )

[أبو هادي]

السلام عليكم

تنقيح وتعديل في دالة تقسيم الأسماء وأهمها إزالة المسافات الزائدة حيث كانت تعطي نتائج خاطئة بسببها :

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 While True
    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

تحياتي .

[أمجد جمالي]

السلام عليكم

أولاً-تحياتي لك اخت جنان صاحب هذا الكود الاستاذ ابو هادي وليس انا

ثانياً-استاذ ابو هادي الله يعطيك العافية على اهتمامك بس واجهتني مشكلة ومن بعد مناقشتها مع اخي وصديقي سهل العريشي قام بارفاق ملف بكود مختلف وانحلت الحمدلله .

المشكلة هيه انو كودك يقوم بتجزئة الاسم الرباعي الي اربع خانات بشرط وجود المسافة بين الاسم والاسم وهناك حالة استثنائية في الاسماء المركبة .

طيب لو رغبت ان اجزء رقم الهوية المؤلف من 10 ارقام وطبعاً لا يوجد مسافة بين الرقم والرقم فكيف يمكن عمل ذلك

انا لا اطلب منك كود جاهز ولكن اطلب الشرح لعمل ذلك

مع تحياتي

[أبو هادي]

السلام عليكم

إذا كان المطلوب لنفس النموذج المرفق في مشاركة الأخ أبو نعيم فهذا الكود يفي بالغرض :

Sub LaborIDSplit()
  Dim K As Byte
  Dim ID As String * 10
  
  ID = Me.RecordsetClone!IDNo
  If Len(Trim(ID)) <> 10 Then Exit Sub
   
  ID = Trim(ID)
  For K = 1 To 10
    Me("[ID" & K - 1 & "]") = Mid(ID, K, 1)
  Next K
End Sub

على أن يوضع في الموديول التابع للنموذج نفسه .

تحياتي .

[أمجد جمالي]

شكراً ما قصرت

اصبح الان طريقتين لنفس الغرض طريقة الاخ ابو نعيم المرفقة مع مشاركته وطريقتك

[سهل احمد العريشي]

بسم الله الرحمن الرحيم

أستاذنا العزيز ابو هادي لو ممكن بس سؤال هل علم الأكواد هو وراثه ولو كان وراثه أتمنى تطلع قريبي لو من بعيد علشان يطولني لو شئي بسيط من طريقتك

أنا من المتابعين لك أنت وبعض الأخوان مثل ابو عقيل او الأستاذ محمد طاهر وكثير من الأخوان ولكن ما يعجبني أن لك أسلوب جميل وبسيط جدا فأرجو منك فتح موضوع هنا أذا كان لديك وقت لتشرح فيه لنا جميعا هذا العلم فأنا أعتقد والله أعلم أنه في 99% من العمل ممكن أن نستغني عن الأستعلامات أذا كان لدينا الكود المناسب فهل توافقني في الرأي وهل بأمكانك وضع درس حتى لو أسبوعي ويكون موضوع مثبت حتى نستفيد جميعا هذا رجائي وأملي فيك بعد الله وتقبل شكري وأحترامي وتقديري لشخصك الكريم

أخيك سهل احمد ( ابو نعيم )

[أمجد جمالي]

السلام عليكم

وانا كمان اضم صوتي لصوت الاخ سهل

واستاذ ابو هادي إذا لاحظت في مشاركتي ذكرت

انا لا اطلب منك كود جاهز ولكن اطلب الشرح لعمل ذلك

وشكراً

[أبو هادي]

السلام عليكم

أضحكتني أخي أبو نعيم أضحك الله سنك :d

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

مع أني قمت بتدريس المحاسبة لطلاب الدبلوم والرياضة المالية لطلاب التوجيهي ، إلا أني أجد نفسي الآن عاجزا عن الشرح وتوصيل المعلومات بشكل يسهل استيعابها .

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

تحياتي .