تجزئة حقل الاسم بشرط

[SAROOK]

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

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

عند تطبيق التقسيم في البرنامج سوف يظهر الاسم عبدالعزيز (صالح عبدالعزيز بن ) 

ومااريد تنفيذه هو شرط ان يتوقف عمل الكود ( كود التقسم ) في حال ان الاسم يحوى اكثر من اربع مقاطع  وان يتم تقسيم الاسم بطريق يدوي بمعنى ان يتم توزيع هذا الاسم على الخانات الاربعة بطريقة الادخال العادي 

تحياتي  

تجزئة النص.mdb

[Foksh]

تفضل أخي @SAROOK ، تم التعديل على مديول المرفق وتوسيعه ليشمل كلمة "بن" أينما وردت بين مقاطع الإسم ، في الكود التالي :-

 

Public Function qsplit(FullName As String, i As Integer) As String
    Dim parts() As String
    Dim j As Integer
    Dim namePart As String
    
    parts = Split(FullName, " ")
    
    For j = 0 To UBound(parts) - 1
        If InStr(parts(j), "بن") > 0 Then
            parts(j) = parts(j) & " " & parts(j + 1)
            parts(j + 1) = ""
        End If
    Next j
    
    Dim count As Integer
    For j = 0 To UBound(parts)
        If parts(j) <> "" Then
            If count = i Then
                qsplit = parts(j)
                Exit Function
            End If
            count = count + 1
        End If
    Next j
End Function

 

مع بقاء الإستدعاء كما هو في الملف المرفق لك ، وهذا ملفك بعد التعديل :-

Splite Names.accdb

 

 

 

تم تعديل April 30 بواسطه Foksh

[SAROOK]

الان, SAROOK said:

 

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

مساءك سعيد بشمهندس foskh

اشكرك وبارك الله فيك  

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

بمعنى اخر ان يعمل شرط التقسيم كما هو 

ولكن

يتوقف عمله في حال اكتشف ان هذا الاسم الرباعي  يحوى اكثر من اربع مقاطع

ويتم السماح بالتقسيم اليدوي وان ندخل هذا الاسم في مربعات التقسيم  يدويا

تحياتي 

 

[Foksh]

توضحت الفكرة .. اليك حلين اثنين واختر ما تريده .

الأول لو كان الإسم أكبر من 4 مقاطع :-

Private Sub comb1_Click()
    Dim parts() As String
    parts = Split(txtNm.Value, " ")
    
    If UBound(parts) > 3 Then
        MsgBox "النص أكبر من 4 مقاطع"
        Exit Sub
    End If

    name1 = parts(0)
    name2 = parts(1)
    name3 = parts(2)
    name4 = parts(3)
End Sub

والثاني تحسباً لو كان الإسم أقل من 4 مقاطع :-

Private Sub comb1_Click()
    Dim parts() As String
    parts = Split(txtNm.Value, " ")
    
    If UBound(parts) > 3 Then
        MsgBox "النص أكبر من 4 مقاطع"
        Exit Sub
    ElseIf UBound(parts) < 3 Then
        MsgBox "النص أصغر من 4 مقاطع"
        Exit Sub
    End If

    name1 = parts(0)
    name2 = parts(1)
    name3 = parts(2)
    name4 = parts(3)
End Sub

جرب واخبرني بالنتيجة 😊

[SAROOK]

الان, Foksh said:

t

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

تسلم بشمهندس foskh 

هذا هو  المطلوب 

جزاك الله خيرا وصحة وعافية

[wael_rafat]

23 ساعات مضت, Foksh said:

Public Function qsplit(FullName As String, i As Integer) As String
    Dim parts() As String
    Dim j As Integer
    Dim namePart As String
    
    parts = Split(FullName, " ")
    
    For j = 0 To UBound(parts) - 1
        If InStr(parts(j), "بن") > 0 Then
            parts(j) = parts(j) & " " & parts(j + 1)
            parts(j + 1) = ""
        End If
    Next j
    
    Dim count As Integer
    For j = 0 To UBound(parts)
        If parts(j) <> "" Then
            If count = i Then
                qsplit = parts(j)
                Exit Function
            End If
            count = count + 1
        End If
    Next j
End Function

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

بارك الله فيك استاذي العزيز  ...  ولكن عندي استفسار  

لماذا هذا الكود يشتغل على اوفيس 2016   32 بت تمام   ، ولم يشتغل على اوفيس 365  64 بت وبدون اي رسائل خطأ  فقط عدم استجابة

   مع الشكر استاذي الفاضل ...  علما ايضا ان كثير من الاكواد لم تشتغل على  اوفيس 2021 32 بت ايضا   ولا يوجد اي رسائل خطأ  وانما لا يستجيب الكود

 اريد ان اعرف اين تكمن المشكلة ؟؟؟؟  مع الشكر

تم تعديل مايو 1 بواسطه wael_rafat

[Foksh]

7 دقائق مضت, wael_rafat said:

ولم يشتغل على اوفيس 365  64 بت

وعليكم السلام ورحمة الله وبركاته أخي الكريم ، بالنسبة للأوفيس 365 فأنا لم أجربه للأسف كثيراً ومعتمد على 2016 لاستقراره وعدم مواجهتي لأي مشاكل عند استخدامه .

9 دقائق مضت, wael_rafat said:

 اريد ان اعرف اين تكمن المشكلة ؟؟؟؟

أعتقد هي المشكلة في أوفيس 365 , وعل أحد الأساتذة والأخوة تجربة الكود على إصدار 365 لمن يملكه ! وإفادتنا بالنتيجة