تعديل كود فورم استعلام وطباعة

[جلال محمد]

السلام عليكم 

في الملف المرفق فورم وظيفتة استعلام عن بعض البيانات الخاصة بغياب الطلاب

ضبطت كل اسماء الازرار واللست بكس ومطابقة باسمائها في الكود ولكن غلبني خطأ لم استطع حله ... مرفق صورة من الخطأ 

فارجو منكم تجربة الفورم وازالة الخطأ المتكرر

Book5.xlsm

[Foksh]

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

اخي الكريم ، الدالة GetDateColumn غير موجودة في الأكواد ، وهذا سبب الرسالة .

[جلال محمد]

ارجو اضافة الدالة GetDateColumn في الكود حتي اتخلص من هذة الرساله

[Foksh]

رغم أن معظم الأكواد تحتاج الى إعادة هيكلة وتصحيح ، ولكن جرب هذا المقترح ، بعد ما تمت تجربته على ملفك السابق :-

Private Function GetDateColumn(ByVal searchDate As Date) As Long
    Dim cell As Range
    Dim searchRange As Range
    
    Set searchRange = wsData.Range(wsData.Cells(HEADER_ROW, DATE_COL_START), _
                                  wsData.Cells(HEADER_ROW, wsData.Columns.Count))
    
    For Each cell In searchRange
        If IsDate(cell.Value) Then
            If CDate(cell.Value) = searchDate Then
                GetDateColumn = cell.Column
                Exit Function
            End If
        End If
    Next cell
    
    GetDateColumn = 0
End Function

 

جرب الملف التالي وشوف النتيجة

 

Book5.zip

[جلال محمد]

تمام ... شكرا جزيلا Foksh

الاوامر تعمل جيدا 

باقي زر الطباعه عند معاينة الطباعه يتوقف الفورم امام المعاينة وبالتالي يتوقف الملف عن العمل 

[Foksh]

17 دقائق مضت, جلال محمد said:

باقي زر الطباعه عند معاينة الطباعه يتوقف الفورم امام المعاينة وبالتالي يتوقف الملف عن العمل 

تمام أخي الكريم ،،

نستطيع تلافي المشكلة بإخفاء النموذج بشكل مؤقت أثناء المعاينة !!

استخدم الكود التالي في زر المعاينة ، وجرب

Private Sub btnPrint_Click()
    If lstResults.ListCount = 0 Then
        MsgBox "لا توجد نتائج لطباعتها", vbExclamation: Exit Sub
    End If
    
    Dim sh As Worksheet, nextRow As Long, i As Long, j As Long
    Const REPORT_SHEET As String = "تقرير الغياب"
    
    Me.Hide
    
    On Error Resume Next: Application.DisplayAlerts = False
    Worksheets(REPORT_SHEET).Delete
    Application.DisplayAlerts = True: On Error GoTo 0
    Set sh = Worksheets.Add(After:=Worksheets(Worksheets.Count))
    sh.Name = REPORT_SHEET
    
    For j = 0 To lstResults.ColumnCount - 1
        sh.Cells(1, j + 1).Value = "العمود " & j + 1
    Next j
    sh.Range("A1:" & sh.Cells(1, lstResults.ColumnCount).Address).Font.Bold = True
    
    nextRow = 2
    For i = 0 To lstResults.ListCount - 1
        For j = 0 To lstResults.ColumnCount - 1
            sh.Cells(nextRow, j + 1).Value = lstResults.List(i, j)
        Next j
        nextRow = nextRow + 1
    Next i
    
    sh.Columns.AutoFit
    
    sh.PageSetup.Orientation = xlPortrait
    sh.PageSetup.Zoom = False
    sh.PageSetup.FitToPagesWide = 1
    sh.PageSetup.FitToPagesTall = 1
    sh.PrintPreview
    
    Me.Show
End Sub

 

[جلال محمد]

تمام ... شكرا جزيلا 

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

[عبدالله بشير عبدالله]

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

مبدع  دائما معلمنا Foksh 

ملاحظنان للاستاذ جلال محمد

الاولى
في بداية اكواد الفورم 

Private Const DATE_COL_START   As Long = 7    قم بتعديل 7 الى 5 وهو اول عمود به تاريخ في الشيت

الملاحظة الثانية 

الخيار الاخير  في القورم   غياب مدة بين تاريخين لعدة فصول وتاتى رسالة             MsgBox "اختر فصل واحد على الأقل", 

 فاذا كان الخيار فصل واحد لا مشكلة ولكن اذا اردنا اختيار اكثر من فصل  فلا توجد وسيلة لذلك لان الفصول في الكائن cmbClass هو ComboBox، وليس

ListBox، ولذلك لا يحتوي على خاصية .Selected(index)، فهي خاصة بالكائنات التي تسمح بتحديد متعدد مثل ListBox من النوع fmMultiSelectMulti

فاعتقد استبدال cmbClass  ب ListBox افضل للخيار الاخير

لكما وافر التقدير والاحترام

تم تعديل منذ 1 ساعه بواسطه عبدالله بشير عبدالله

[Foksh]

45 دقائق مضت, عبدالله بشير عبدالله said:

Private Const DATE_COL_START   As Long = 7    قم بتعديل 7 الى 5 وهو اول عمود به تاريخ في الشيت

---------------------------

فاعتقد استبدال cmbClass  ب ListBox افضل للخيار الاخير

في الحقيقة ، كانت من بين الأمور التي بحاجة لتعديلات ، و وجهة نظرك سليمة 100% أستاذنا الفاضل  ..

مبدعون في تخصصكم ، وما أنا إلا بمبتدئ في مجال الكسل أخي عبدالله ، ولكني وجدت أن المسار بين آكسيس وأكسل متشابه الى حد ما ، ما دفعني الى الخوض في تجربة التعرف على اكسل بشكل أعمق ( تعميق علاقة بيني وبينه 😂 ) .