دمج خلية رقم الموظف المتكرر في تقرير اكسيس

frqd · سبتمبر 6, 2023

السلام عليكم

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

A.xls Database1.accdb

**Barna** · سبتمبر 6, 2023

تابع هذا الموضوع والشرح الرائع من المبدع @jjafferr

في 23‏/12‏/2022 at 11:35, jjafferr said:

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

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

.

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

.

طريقة العمل :

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. لا تحتاج الى عمل اي تغيير في الاحداث اعلاه ، فقط انسخها من هنا والصقها في تقريرك ،

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

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

.

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