فصل الاسم المركب قبل "-"

[طاهر اوفيسنا]

السلام عليكم أساتذي الكرام

1- ياريت مساعدة بالتعديل على الاستعلام والمتمثل في :

التعديل على كود الفصل في الاسم المركب سوى احادي او ثنائي او ثلاثي او رباعي

المهم يكون الفصل في الاسم المركب قبل " - " لوحده

الحالي: الماء الأبيض - تبسة / الكود يفصلها  " الماء " و " الأبيض "

المطلوب : الماء الأبيض - تبسة / الكود يفصلها " الماء الأبيض "

2- كيف يستدعى كود الفصل في تقرير مثلا

وشكرا

 

 

 

فصل ماقبل المطة.rar

[Foksh]

31 دقائق مضت, طاهر اوفيسنا said:

السلام عليكم

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

تم تعديل المديول ليصبح :-

Option Compare Database
Option Explicit

Function PartOfName(InName As String, NumberOfPart As Byte) As String
    Dim parts() As String
    Dim tempName As String
    Dim i As Integer
    Dim currentIndex As Integer
    Dim normalizedParts() As String
    Dim j As Integer
    
    tempName = Trim(InName)
    PartOfName = ""
    If tempName = "" Then Exit Function
    
    tempName = Replace(tempName, " -", " - ")
    tempName = Replace(tempName, "- ", " - ")
    tempName = Replace(tempName, "  ", " ")
    
    parts = Split(tempName, " - ")
    
    currentIndex = 0
    ReDim normalizedParts(0 To 0)
    
    For i = 0 To UBound(parts)
        If Trim(parts(i)) <> "" Then
            normalizedParts(currentIndex) = Trim(parts(i))
            If i < UBound(parts) Then
                ReDim Preserve normalizedParts(0 To currentIndex + 1)
                currentIndex = currentIndex + 1
            End If
        End If
    Next i
    
    If UBound(normalizedParts) > 0 Then
        If NumberOfPart - 1 <= UBound(normalizedParts) Then
            PartOfName = Trim(normalizedParts(NumberOfPart - 1))
        End If
    Else
        Dim words() As String
        words = Split(tempName, " ")
        If NumberOfPart - 1 <= UBound(words) Then
            PartOfName = Trim(words(NumberOfPart - 1))
        End If
    End If
End Function

Function NoSpaces(InName As String) As String
    Dim NewName As String
    Dim i As Integer
    Dim TheStr As String
    Dim ThePrevStr As String
    
    InName = Trim(InName)
    For i = 1 To Len(InName)
        TheStr = Mid(InName, i, 1)
        If TheStr = " " And ThePrevStr = " " Then TheStr = ""
        If TheStr <> "" Then ThePrevStr = TheStr
        NewName = NewName & TheStr
    Next
    NoSpaces = NewName
End Function

 

وتم تعديل الإستعلام ليصبح :-

SELECT Table1.Name, PartOfName([Name],1) AS Firstname, PartOfName([Name],2) AS Secondname, PartOfName([Name],3) AS Thirdname, PartOfName([Name],4) AS Forthname, PartOfName([Name],5) AS SubFamily, PartOfName([Name],6) AS Family, [SubFamily] & " " & [Family] AS Familyname
FROM Table1
WITH OWNERACCESS OPTION;

 

ملفك بعد التعديل :-

 

فصل ماقبل المطة.zip

[طاهر اوفيسنا]

8 دقائق مضت, Foksh said:

ملفك بعد التعديل :-

شكرا استاذ على التعديل الصحيح

والان كيف يستدعى الكود في التقرير علما ان name1 هو المعني 

Me.Da5.Caption = Format(rs!Date_Marj, "yyyy/mm/dd") & " بـ" & name1 & "  تحت رقم :  " & rs!N_Act_Marj

 

[Foksh]

2 دقائق مضت, طاهر اوفيسنا said:

التقرير

أين التقرير في مرفقك للتطبيق والتجربة ؟؟

[طاهر اوفيسنا]

15 دقائق مضت, Foksh said:

أين التقرير في مرفقك للتطبيق والتجربة ؟؟

سأوافيك بها غدا بحول الله

[طاهر اوفيسنا]

اليك المرفق استاذ للتعديل علما اني موقف الكود القديم في حدث عند  التحميل 

'هنا كود الفصل القديم متوقف
' Dim LongName As String, Myst As Integer, Myend As Integer
' 'Valid for 5 Names only
' Dim PartName(5) As String, k As Integer
' LongName = Me.dal.Caption '.text
'Myst = 1
' For i = 1 To Len(LongName)
'  Myend = Myend + 1
'   If Mid(LongName, i, 1) = " " Then
'   k = k + 1
'      ' to assign the First Name
'      If i <> Len(LongName) Then
'      PartName(k) = Mid(LongName, Myst, Myend - Myst)
'      End If
'      ' to Start count the letters of a new word
'      Myst = Myend + 1
'    If k = 5 Then
'     MsgBox "More than Five names is not allowed "
'     Exit Sub
'    End If
'   End If
'      If i = Len(LongName) Then
'      k = k + 1
'      PartName(k) = Mid(LongName, Myst, Myend - Myst + 1)
'      End If
'Next i

'هنا يكون استدعاء الكود
'Me.name1 = PartOfName([name1], 1)
Me.da5.Caption = Format(rs!Date_Marj, "yyyy/mm/dd") & " بـ" & name1 & "  تحت رقم :  " & rs!N_Act_Marj

Wil12.rar

تم تعديل منذ 5 ساعات بواسطه طاهر اوفيسنا

[Foksh]

أمرك عجيب غريب فيما ترسله من عملك .

في ملفك كيف نصل الى التقرير Face6 !!!!!!!!!

 

[Eng.Qassim]

السلام عليكم

محاولة بسيطة...

New Microsoft Access Database.rar

[طاهر اوفيسنا]

20 دقائق مضت, Foksh said:

في ملفك كيف نصل الى التقرير Face6 !!!!!!!!!

ركز مع الصورة تصل الى التقرير

14 دقائق مضت, Eng.Qassim said:

السلام عليكم

وعليكم السلام استاذ ليس بتقرير له مصدر سجلات بل تقرير كله اكواد في اكواد 

[Foksh]

3 ساعات مضت, طاهر اوفيسنا said:

Me.da5.Caption = Format(rs!Date_Marj, "yyyy/mm/dd") & " بـ" & name1 & "  تحت رقم :  " & rs!N_Act_Marj

استبدل الجملة السابقة ، بالجملة التالية :-

Me.da5.Caption = Format(rs!Date_Marj, "yyyy/mm/dd") & " بـ" & _
                PartOfName(name1, 1) & " " & PartOfName(name1, 2) & _
                "  تحت رقم :  " & rs!N_Act_Marj

 

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

[طاهر اوفيسنا]

21 دقائق مضت, Foksh said:

استبدل الجملة السابقة ، بالجملة التالية :-

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

تم تعديل منذ 1 ساعه بواسطه طاهر اوفيسنا

[Foksh]

تحقق من أن مربع النص name1 يحمل قيمة فعلية وليس فارغاً..

وللتأكيد صور رسالة الخطأ نفسه للتحقق.

[طاهر اوفيسنا]

منذ ساعه, Foksh said:

تحقق من أن مربع النص name1 يحمل قيمة فعلية وليس فارغاً..

تم الغاء name1 واستبداله باسم الحقل الموجود في الجدول Lieu_Marij في الكود المعدل فنجحت العملية شكرا لك استاذ Foksh ربي يحفظك