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

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

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

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