مساعدة في تعديل تصميم تقرير (بياناته من استعلام جدولين وفيه خاصية التجميع)

[Muhann3d]

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

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

1- جدويل الموظفين 

2- جدول الاجازات

كل موظف لديه اجازة واحدة او اكثر، عندما انشئ تقرير باستخدام الاستعلام  واعمل تجميع على الاسم (حتى لايتكرر الاسم) يكون التصميم كما مبين في الصورة ادناه. 

كما موضح في الصورة اعلاه انا بحاجة ان تكون الحقول المؤشر عليها في السهم الاحمر  (التابعة للاسم عمر ابراهيم) تبدأ من موقع الحقل المؤشر عليه في السهم الاخضر (تبدأ من صف الاسم عمر ابراهيم).

ليكون بشكل تقريبي مثل الجدول ادناه

 

وفقكم الله لما يحبه ويرضاه  

 

تقرير اجازات.rar

 

تم تعديل April 27 بواسطه Muhann3d

[kanory]

اقرأ هذا الموضوع وسوف يساعدك في ذلك ...................................

 

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

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

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 50.86 kB · 100 downloads

 

[Muhann3d]

جزاك الله خير اخي 

استخدمت طريقة الاخ جعفر بارك الله فيه،

تم دمج عامود اسم الموظف ولكن بقى عمود التسلسل كيف اتعامل معاه حتى يكون لكل اسم تسلسل؟

(عامود التسلسل غير موجود في الجدول. فقط في التقرير)

تقرير اجازات.rar

تم تعديل April 27 بواسطه Muhann3d

[kanory]

21 ساعات مضت, Muhann3d said:

استخدمت طريقة الاخ جعفر بارك الله فيه،

تم دمج عامود اسم الموظف ولكن بقى عمود التسلسل كيف اتعامل معاه حتى يكون لكل اسم تسلسل؟

(عامود التسلسل غير موجود في الجدول. فقط في التقرير)

 

هل تريدها بهذا الشكل ؟؟؟

 

[Muhann3d]

22 دقائق مضت, kanory said:

هل تريدها بهذا الشكل ؟؟؟

 

نعم هذا ما اريده

[kanory]

11 دقائق مضت, Muhann3d said:

نعم هذا ما اريده

طيب تفضل <<<<<<<<>>>>>>>>

 

تقرير اجازات.accdb

[Muhann3d]

جزاك الله خير هذا بالضبط ما اريده.

بحثت كثيراً على مثل هذا الحل في المواقع ولم اجده حتى استخدمت ChatGPT ولم اصل الى نتيجة.

هل من الممكن شرح مبسط لدالة GenerateSequence 

تم تعديل April 28 بواسطه Muhann3d

[kanory]

35 دقائق مضت, Muhann3d said:

هل من الممكن شرح مبسط لدالة GenerateSequence 

طيب ، سأشرح لك الدالة `GenerateSequence` 

هذه الدالة تقوم بإنشاء تسلسل رقمي للاسماء المتشابهة في استعلام :

1. `Function GenerateSequence( FullName As String) As Integer`: هذا تعريف الدالة `GenerateSequence` التي تأخذ مُدخل واحد يُسمى ` FullName` من نوع `String` وتُرجع قيمة من نوع `Integer`.

2. `Static dict As Object`: هنا نُعرف متغير `dict` ككائن `Object`. الكلمة `Static` تعني أن الكائن `dict` سيحتفظ بقيمته حتى بعد انتهاء تنفيذ الدالة، وهذا مهم لأننا نريد أن يحتفظ القاموس بالاسماءوالأرقام المتسلسلة التي تم إضافتها سابقًا.

3. `If dict Is Nothing Then Set dict = CreateObject("Scripting.Dictionary")`: هذا الشرط يتحقق إذا كان الكائن `dict` لم يتم إنشاؤه بعد، وفي هذه الحالة يتم إنشاء كائن جديد من نوع "Dictionary" (قاموس).

4. `If Not dict.exists( FullName) Then`: هذا الشرط يتحقق إذا كان الاسم` FullName` غير موجود في القاموس `dict`.

5. `dict.Add  FullName, dict.Count + 1`: إذا كان الاسم` FullName` غير موجود، يتم إضافته إلى القاموس مع قيمة تسلسل رقمي جديدة تُحسب بإضافة واحد إلى عدد الاسماء الموجودة في القاموس.

6. `GenerateSequence = dict( FullName)`: في النهاية، تُرجع الدالة القيمة المتسلسلة للاسم` FullName` الموجود في القاموس.

باستخدام هذه الدالة في استعلام، يمكنك إنشاء حقل محسوب يعرض رقمًا متسلسلًا لكل اسم متشابه بناءً على ترتيب ظهوره في الاستعلام. هذا مفيد لتتبع الاسماء وترتيبها بشكل فريد داخل الاستعلام.

[Muhann3d]

الله يوفقك ان شاء الله اخ kanory

جزيل الشكر والامتنان لحضرتك