في التقرير ، دمج عمودي/عمل حقل بارتفاع مجموعة حقول - لحقل او مجموعة حقول

[jjafferr]

السلام عليكم 🙂

 

اذا عندنا تقرير بهذه الطريقة:

.

اليس الافضل دمج بيانات الحقل المتكررة عموديا في حقل واحد ، مثل الوورد مثلا الى :

.

 

طريقة العمل :

1. اعمل تقريرك بالطريقة اللي تراها مناسبة ، بالفرز والتصفية :

.

او بالمجاميع :

.

2. ولكن قم بوضع جميع الحقول في قسم "التفصيل" Detail :

.

3. ثم اجعل برواز جميع حقول هذا القسم شفافة

.

4. ثم الحقول التي تريد دمجها ، اخفاء المتكرر = نعم ، Hide Duplicates = Yes

.

5. ثم ضع هذه الاحداث للتقرير 

Private Sub Detail_Print(Cancel As Integer, PrintCount As Integer)

    'Border color not set, use field ForeColor
    Call Detail_Print_Run_All(5, "'اليوم', 'التاريخ','الزمن'")
End Sub

Private Sub Report_Open(Cancel As Integer)

    Call Report_Open_Run(Me.Name)
End Sub

Private Sub Report_Close()
    On Error Resume Next
    Set ctl_ReSize = Nothing
End Sub

Private Sub Report_Page()

    Call Report_Page_Run
End Sub

.

6. لا تحتاج الى عمل اي تغيير في الاحداث اعلاه ، فقط انسخها من هنا والصقها في تقريرك ،

ما عدا اول جزء :

1. عرض البرواز ،
2. حيث نخبره باسماء الحقل/الحقول التي نريد دمجها عموديا ،
3. لون البرواز يكون حسب اللون الذي نكتبه ،
4. او اذا لم نكتب لون البرواز ، فلون البرواز سيكون لون نص الكلمات في الحقل

 

.

7. نسخ الوحدة النمطية mod_Report_Field_Hieght_ReSize الى تقريرك ن وكذلك بدون عمل اي تغيير فيها :

Option Compare Database
Option Explicit

    Dim rpt_Name_ReSize As String
    Dim rgb_Border_ReSize As Long, ini_rgb_Border_ReSize As Long
    Dim Detail_Calc_Height_ReSize As Long
    Dim Exclude_fld_Name_ReSize As String
    Dim Add_H_Each_Record_ReSize As Boolean
    Dim fildMaxHeight_ReSize As Long
    Dim myDrawWidth As Integer
    Public ctl_ReSize As Control
    Dim i_ReSize As Integer, j_ReSize As Integer
    Dim x_ReSize() As String, tmp_ReSize As String
    Dim Count_Pages_ReSize As Integer
    Dim sfld_Name_ReSize() As String, sfld_Value_ReSize() As String, _
        sfld_Count_ReSize() As Integer
    Dim L_ReSize As Single, T_ReSize As Single, W_ReSize As Single, H_ReSize As Single
'

Function Detail_Print_Run_All(LineWidth As Integer, myFields As String, Optional border_Color As Long = 1)
        
    'we can this Function in the following ways, indicating Border Color
    'Call Detail_Print_Run_All(5, "'c1', 'save', 'b1'", RGB(0, 0, 0))  'Border color is RGB Value
    'Call Detail_Print_Run_All(5, "'c1', 'save', 'b1'", vbBlack)       'Border color is Black
    'Call Detail_Print_Run_All(5,"'c1', 'save', 'b1'", vbMagenta)      'Border color is Magenta
    'Call Detail_Print_Run_All(5,"'c1', 'save', 'b1'")                 'Border color not set, use field ForeColor
    'Call Detail_Print_Run_All(5,"'b1'", RGB(0, 0, 0))
        
    '5 is Line Width
    
    'we get most the Lines drawn in Detail Section,
    'except for the Last Record in each page, where we use Report Page event (the last page is easy)
    
    ini_rgb_Border_ReSize = border_Color
    rgb_Border_ReSize = ini_rgb_Border_ReSize
    Exclude_fld_Name_ReSize = myFields
    Add_H_Each_Record_ReSize = False
    myDrawWidth = LineWidth
    
    'make an array of the fields
    x_ReSize = Split(Exclude_fld_Name_ReSize, ",")
    
    ReDim Preserve sfld_Name_ReSize(UBound(x_ReSize))
    ReDim Preserve sfld_Value_ReSize(UBound(x_ReSize))
    ReDim Preserve sfld_Count_ReSize(UBound(x_ReSize))

    
'1
    'do the Detail Lines for the remaining fields
    Call Detail_Sec_Max_Height
    


'2
    'now work on the special fields Lines
    For i_ReSize = 0 To UBound(x_ReSize)

        'remove the ' , and the extra spaces from the Left and Right
        tmp_ReSize = RTrim(LTrim(Replace(x_ReSize(i_ReSize), "'", "")))
        sfld_Name_ReSize(i_ReSize) = tmp_ReSize
        Call Scale_Box_Lines(tmp_ReSize)
        
    Next i_ReSize

End Function


Function Report_Open_Run(rpt_Name_ReSize_1)
    
    rpt_Name_ReSize = rpt_Name_ReSize_1
    
    'Reset the variables from here
    Count_Pages_ReSize = 0
    Erase sfld_Name_ReSize
    Erase sfld_Value_ReSize
    Erase sfld_Count_ReSize
    
    Detail_Calc_Height_ReSize = 0
    
End Function


Function Report_Page_Run()

    
    'make an array of the fields
    x_ReSize = Split(Exclude_fld_Name_ReSize, ",")
    
    
    'now work on the special fields Lines
    For j_ReSize = 0 To UBound(x_ReSize)

        'remove the ' , and the extra spaces from the Left and Right
        tmp_ReSize = RTrim(LTrim(Replace(x_ReSize(j_ReSize), "'", "")))
        sfld_Name_ReSize(j_ReSize) = tmp_ReSize
     
        Set ctl_ReSize = Reports(rpt_Name_ReSize)(tmp_ReSize)
    
        If ini_rgb_Border_ReSize = 1 Then
            rgb_Border_ReSize = ctl_ReSize.ForeColor
        End If
    
        'make it simple to understand
        L_ReSize = ctl_ReSize.Left
        W_ReSize = ctl_ReSize.Width
        T_ReSize = ctl_ReSize.Top
        'H_ReSize = ctl_ReSize.Height
    

        'we have to add the Sections/Fields ABOVE the Detail Section
        If Reports(rpt_Name_ReSize).Page = 1 Then
            H_ReSize = Detail_Calc_Height_ReSize + _
                       Reports(rpt_Name_ReSize).PageHeaderSection.Height + _
                       Reports(rpt_Name_ReSize).ReportHeader.Height
        Else
            H_ReSize = Detail_Calc_Height_ReSize + _
                       Reports(rpt_Name_ReSize).PageHeaderSection.Height
        End If
    
        Reports(rpt_Name_ReSize).DrawWidth = myDrawWidth
        Reports(rpt_Name_ReSize).Line (L_ReSize, T_ReSize + H_ReSize)-(L_ReSize + W_ReSize, T_ReSize + H_ReSize), rgb_Border_ReSize 'Bottom Line

    Next j_ReSize
    
    Detail_Calc_Height_ReSize = 0
    
End Function


Public Function Scale_Box_Lines(fld_Name As String)
    
    
    Set ctl_ReSize = Reports(rpt_Name_ReSize)(fld_Name)

    'make it simple to understand
    L_ReSize = ctl_ReSize.Left
    W_ReSize = ctl_ReSize.Width
    T_ReSize = ctl_ReSize.Top
    H_ReSize = ctl_ReSize.Height
        
    
    If ini_rgb_Border_ReSize = 1 Then
        rgb_Border_ReSize = ctl_ReSize.ForeColor
    End If
        
      
    'take the highst Height
    If fildMaxHeight_ReSize > H_ReSize Then
        H_ReSize = fildMaxHeight_ReSize
    End If
        
            
    If ctl_ReSize.Text <> sfld_Value_ReSize(i_ReSize) Then
        sfld_Value_ReSize(i_ReSize) = ctl_ReSize.Text
        sfld_Count_ReSize(i_ReSize) = 1
    End If
            
       

    'Box the cells
    
        'Left and Right
        ctl_ReSize.BorderColor = vbWhite
        Reports(rpt_Name_ReSize).DrawWidth = myDrawWidth
        Reports(rpt_Name_ReSize).Line (L_ReSize, T_ReSize)-(L_ReSize, H_ReSize), rgb_Border_ReSize             'Left Line
        Reports(rpt_Name_ReSize).Line (L_ReSize + W_ReSize, T_ReSize)-(L_ReSize + W_ReSize, H_ReSize), rgb_Border_ReSize     'Right Line


    'Top and Bottom
    If Reports(rpt_Name_ReSize).Page <> Count_Pages_ReSize Then
        'first
        Count_Pages_ReSize = Count_Pages_ReSize + 1
        Reports(rpt_Name_ReSize).Line (L_ReSize, T_ReSize)-(L_ReSize + W_ReSize, T_ReSize), rgb_Border_ReSize   'Top Line

    ElseIf sfld_Count_ReSize(i_ReSize) = 1 Then 'First Record
        Reports(rpt_Name_ReSize).Line (L_ReSize, T_ReSize)-(L_ReSize + W_ReSize, T_ReSize), rgb_Border_ReSize   'Top Line
        
    End If


    sfld_Count_ReSize(i_ReSize) = sfld_Count_ReSize(i_ReSize) + 1

End Function

Public Function Detail_Sec_Max_Height()

    
    fildMaxHeight_ReSize = 0
    
    'get the max Height
    For Each ctl_ReSize In Reports(rpt_Name_ReSize).Section(0).Controls
        If ctl_ReSize.Height > fildMaxHeight_ReSize Then
            fildMaxHeight_ReSize = ctl_ReSize.Height
        End If
    Next
    
    'Draw lines around the fields
    For Each ctl_ReSize In Reports(rpt_Name_ReSize).Section(0).Controls
        
        If InStr(Exclude_fld_Name_ReSize, "'" & ctl_ReSize.Name & "'") = 0 Then
            Reports(rpt_Name_ReSize).DrawWidth = myDrawWidth
            Reports(rpt_Name_ReSize).Line (ctl_ReSize.Left, ctl_ReSize.Top)-Step(ctl_ReSize.Width, fildMaxHeight_ReSize), ctl_ReSize.ForeColor, B
            
            'just add the Heighs of ONE Record
            If Add_H_Each_Record_ReSize = False Then
                Detail_Calc_Height_ReSize = Detail_Calc_Height_ReSize + fildMaxHeight_ReSize
                Add_H_Each_Record_ReSize = True
            End If
        
        End If
    Next

End Function

.

8. ما عدا هذا الجزء ، والذي يجب ان نضع فيه اسماء جميع الاقسام التي فوق "قسم التفصيل" ، والتي بها ارتفاع :

.

من هنا نعرف اسم هذه الاقسام :

.

 

وهذه نتائج بعض التقارير التي تم النجربة عليها :

.

.

.

.

 

ولم اتوصل لطريقة لجعل الكلمات في منتصف الحقل عموديا ، هكذا:

 

جعفر

 

Report_BoxLine_07.accdb.zip

[kanory]

ما شاء الله تبارك الله

جاري التجربة   .... ولكن هل يمكن توسيط بيانات هذا الحقل المدمج . ؟؟؟؟

 

[طاهر الوليدي]

جميل جدا استاذنا جعفر بارك الله فيك

[kkhalifa1960]

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

تم تعديل ديسمبر 23, 2022 بواسطه kkhalifa1960

[AbuuAhmed]

جهد كبير جدا ، واضح أنه أرهقك كثرا ، حاولت فهم الكود ولكني "تهت" وقلت أرجع له مرة أخرى علني أفهم فكرتك وأسرق منها شيئ.
عساك ع القوة عزيزي.

[jjafferr]

49 دقائق مضت, AbuuAhmed said:

واضح أنه أرهقك كثرا

نعم كان مرهق ، واوقفت تقريبا جميع اعمالي بس علشان اكمله !!

اذا الله سبحانه وتعالى قدّرني ، بكرة ان شاء الله اكتب تفاصيل العمل 🙂

 

9 ساعات مضت, kanory said:

هل يمكن توسيط بيانات هذا الحقل المدمج

محاولاتي الاولى فشلت 😞

اتمنى ابو احمد يقدر يضيف هذه الفقرة في برنامجه ان شاء الله 🙂

 

جعفر

[AbuuAhmed]

12 دقائق مضت, jjafferr said:

اتمنى ابو احمد يقدر يضيف هذه الفقرة في برنامجه ان شاء الله 🙂

عزيزي الحقيقة لو سنلاحق رغبات "الجمهور" سيشغلونا في باقي حياتنا for nothing 
من خلال دراستي لسلوك أداء التقارير فهمت أن الأكسس يقوم بإخفاء القيم المكررة بجعل ارتفاع الأداة "صفر" ، وتبقى القيمة موجودة.
وفكرة الحل إذا أردت أن تحاول فيها أن تلعب في هذا الأمر إذا الأكسس يسمح لنا بالتعديل وهو معرقة السجل الوسط/الأوسط "وفتح" ارتفاعه وجعل ارتفاع السجل الأول صفز.

[ابو البشر]

شكرا للجميع

تم تعديل ديسمبر 23, 2022 بواسطه ابو البشر

[عمر ضاحى]

ما شاء الله مجهود جبار 

والموضوع حاسه كبير جدا علشان استوعبه مره واحده 

لكن جزاك الله عنا كل خير وبارك الله فى علمك وصحتك

[jjafferr]

عملت تعديل اخير ، ورفعته مكان المشاركة الاولى 🙂 

 

في 23‏/12‏/2022 at 14:06, kanory said:

ولكن هل يمكن توسيط بيانات هذا الحقل المدمج . ؟؟؟؟

مع ان جوابي هو ما ممكن ، ولكن اخونا العود @ابوخليل نصحني بعدم استعمال هذه العبارة ، فيمكن يجي مبرمج اشطر مني ، ويعطينا الحل 🙂
ممكن هنا اطلب من اخوي موسى @Moosak ان يحاول بلعبته الجديدة : اداة بحث ثورية ان يجد لنا الحل هناك 🙂

 

جعفر

[kanory]

1 دقيقه مضت, jjafferr said:

عملت تعديل اخير ، ورفعته مكان المشاركة الاولى 🙂 

 

مع ان جوابي هو ما ممكن ، ولكن اخونا العود @ابوخليل نصحني بعدم استعمال هذه العبارة ، فيمكن يجي مبرمج اشطر مني ، ويعطينا الحل 🙂
ممكن هنا اطلب من اخوي موسى @Moosak ان يحاول بلعبته الجديدة : اداة بحث ثورية ان يجد لنا الحل هناك 🙂

 

جعفر

🤐

[haniameen]

عاجز عن الشكر اخي جعفر جعله الله في ميزان حساناتك .... وأرجو ان تتقبل أسفي لتأخري في الرد لظروف خارجة عن ارادتي يعلمها الله سبحانه وتعالى 🥰

[Muhann3d]

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

ملاحظة يظهر خطاً عندما لايحتوي الحقل المُراد دمجه على بيانات.