حل للتقارير متعددة الأعمدة

[AbuuAhmed]

لإضافة التسميات لقسم رأس الصفحة للتقرير في طور التصميم
لتنظيم التسميات لقسم رأس الصفحة للتقرير في طور التشغيل
 

'AbuuAhmed, Officena.net
'2023/06/15

Sub AddReportPageHeaderLabels(rptName As String)
    Dim acr As Byte, acrs As Byte
    Dim col As Byte
    Dim rpt As Report
    Dim ctl As Control, lbl As Control
    Dim lblName As String
    
    'لإضافة التسميات في قسم رأس الصفحة للتقارير متكررة الأعمدة في طور التصميم
    
    'On Error Resume Next
    
    DoCmd.OpenReport rptName, acViewDesign, , , acHidden
    Set rpt = Reports(rptName)
    
    acrs = rpt.Printer.ItemsAcross
    
    With rpt.Section(acPageHeader)
        Do While .Controls.Count > 0
            For Each ctl In .Controls
                Call DeleteReportControl(rptName, ctl.Name)
            Next ctl
        Loop
    
        For acr = 1 To acrs
            col = 0
            For Each ctl In rpt.Section(acDetail).Controls
                col = col + 1
                lblName = "col" & Format(col, "00") & Format(acr, "_00")
                Set lbl = CreateReportControl(rptName, acLabel, acPageHeader, , lblName)
                lbl.Name = lblName
                lbl.Caption = IIf(ctl.Tag = "", ctl.Name, ctl.Tag)
                lbl.ControlTipText = ctl.Name
                lbl.Left = ctl.Left
                lbl.Width = ctl.Width
                lbl.Top = lbl.Height * (acr - 1)
                lbl.TextAlign = 2
                lbl.BorderStyle = 1
                lbl.BackStyle = 1
                lbl.BackColor = RGB(216, 216, 216)
            Next ctl
        Next acr
    
        .Height = 0
    End With
    
    DoCmd.Close acReport, rptName, acSaveYes
    Set rpt = Nothing
    Set ctl = Nothing
    Set lbl = Nothing
    
    MsgBox "Done"
End Sub

Sub ReportOpen4PageHeader(rptName As String)
    Dim col As Byte, cols As Byte
    Dim acr As Byte, acrs As Byte
    Dim rpt As Report
    Dim ctl0 As Control, ctl1 As Control, ctl2 As Control
    
    'لتنظيم التسميات في قسم رأس الصفحة للتقارير متكررة الأعمدة في طور التشغيل
    
    On Error Resume Next
    
    Set rpt = Reports(rptName)
    
    rpt.Printer.ItemLayout = acPRVerticalColumnLayout
    rpt.Printer.DefaultSize = False
    
    cols = rpt.Section(acDetail).Controls.Count
    acrs = rpt.Printer.ItemsAcross
    
    For Each ctl0 In rpt.Section(acPageHeader).Controls
       With rpt.Controls(ctl0.ControlTipText)
            ctl0.Left = .Left
            ctl0.Width = .Width
       End With
    Next ctl0
    
    Set ctl0 = rpt("col" & Format(cols, "00") & "_01")
    
    rpt.Width = rpt.WindowWidth
    For acr = 2 To acrs
        For col = 1 To cols
            Set ctl1 = rpt("col" & Format(col, "00") & "_01")
            Set ctl2 = rpt("col" & Format(col, "00") & Format(acr, "_00"))
            
            With ctl2
                .Left = ctl0.Left + ctl0.Width + IIf(col = 1, rpt.Printer.ColumnSpacing, 0)
                .Top = ctl1.Top
                '.Width = ctl1.Width
                .Height = ctl1.Height
                .BackColor = ctl1.BackColor
                .ForeColor = ctl1.ForeColor
                .BackStyle = ctl1.BackStyle
                .Caption = ctl1.Caption
            End With
            
            Set ctl0 = ctl2
        Next col
    Next acr
    rpt.Width = 0
        
    With rpt.Section(acPageHeader)
        .Height = 0
        .Height = .Height + rpt("col01_01").Top
    End With
    
    Set rpt = Nothing
    Set ctl0 = Nothing
    Set ctl1 = Nothing
    Set ctl2 = Nothing
End Sub

 

حل للتقارير متعددة الأعمدة_01.accdb

تم تعديل يونيو 15, 2023 بواسطه AbuuAhmed
تصحيح الوصف

[AbuuAhmed]

 قد لا يشعر بعضكم بالتعديل في إضافة صناديق التسميات في قسم رأس الصفحة،
عليه بفتح تقرير rptReport2 في طور التصميم وحذف كل صناديق التسميات في قسم رأس الصفحة ثم حفظه،
ثم تشغيل الإجراء AddReportPageHeaderLabels وإعادة فتح التقرير لمشاهدة نتيجة إضافة الصناديق.
للإستفادة الكاملة من حدث الإضافة ينصح بإضافة التسميات في الخاصية Tag لصناديق قسم التفاصيل .

أما من لا يريد استخدام هذا الإجراء ويرغب في إضافة التسميات بنفسه فينصح:
بإضافة أسماء صناديق قسم التفاصيل في خاصية ControlTipText لصناديق قسم رأس الصفحة.

أما بالنسبة للتقرير rptReport1 فقم بفتحه في طور التصميم وانظر إلى بعثرة صناديق التسميات في قسم رأس الصفحة،
ثم أعد فتحه في طور التشغيل لمشاهدة الصناديق وقد صفت بشكل منظم.

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

تم تعديل يونيو 15, 2023 بواسطه AbuuAhmed