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

جرب النعديل ده :

On Error GoTo Err_Handler      'Remove the single quote from start of this line once you have it working.
    'Purpose:       Filter a report to a date range.
    'Documentation: http://allenbrowne.com/casu-08.html
    'Note:          Filter uses "less than the next day" in case the field has a time component.
    Dim strReport As String
    Dim strDateField As String
    Dim strWhere As String
    Dim lngView As Long
    Const strcJetDate = "\#mm\/dd\/yyyy\#"  'Do NOT change it to match your local settings.
    
    'DO set the values in the next 3 lines.
    strReport = "MainReport5Habs"      'Put your report name in these quotes.
    strDateField = "[HabsEnd]" 'Put your field name in the square brackets in these quotes.
    lngView = acViewPreview     'Use acViewNormal to print instead of preview.
    
    'Build the filter string.
    If IsDate(Me.txtStartDate) Then
        strWhere = "(" & strDateField & " >= " & Format(Me.txtStartDate, strcJetDate) & ")"
    End If
    If IsDate(Me.txtEndDate) Then
        If strWhere <> vbNullString Then
            strWhere = strWhere & " AND "
        End If
        strWhere = strWhere & "(" & strDateField & " < " & Format(Me.txtEndDate + 1, strcJetDate) & ")"
Else
   strWhere = "(" & strDateField & " = " & Format(Me.txtStartDate, strcJetDate) & ")"
    End If
    
    'Close the report if already open: otherwise it won't filter properly.
    If CurrentProject.AllReports(strReport).IsLoaded Then
        DoCmd.Close acReport, strReport
    End If
    
    'Open the report.
    Debug.Print strWhere        'Remove the single quote from the start of this line for debugging purposes.
    DoCmd.OpenReport strReport, lngView, , strWhere

Exit_Handler:
    Exit Sub

Err_Handler:
    If Err.Number <> 2501 Then
        MsgBox "Error " & Err.Number & ": " & Err.Description, vbExclamation, "Cannot open report"
    End If
    Resume Exit_Handler

روعة ...... كالمعتاد ... ولكن هناك مشكلة

الكود الاول فى حالة خلو الخانتين txtStartDate ،  txtEndDate يعطى كافة السجلات

بعد التعديل يعطى خطأ

خالص شكرى وتقديرى

On Error GoTo Err_Handler 'Remove the single quote from start of this line once you have it working.

'Purpose: Filter a report to a date range.

'Documentation: http://allenbrowne.com/casu-08.html

'Note: Filter uses "less than the next day" in case the field has a time component.

Dim strReport As String

Dim strDateField As String

Dim strWhere As String

Dim lngView As Long

Const strcJetDate = "\#mm\/dd\/yyyy\#" 'Do NOT change it to match your local settings.

'DO set the values in the next 3 lines.

strReport = "MainReport5Habs" 'Put your report name in these quotes.

strDateField = "[txtStartDate]" 'Put your field name in the square brackets in these quotes.

lngView = acViewPreview 'Use acViewNormal to print instead of preview.

'Build the filter string.

If IsDate(Me.txtStartDate) Then

strWhere = "(" & strDateField & " >= " & Format(Me.txtStartDate, strcJetDate) & ")"

End If

If IsDate(Me.txtEndDate) Then

If strWhere <> vbNullString Then

strWhere = strWhere & " AND "

End If

strWhere = strWhere & "(" & strDateField & " < " & Format(Me.txtEndDate + 1, strcJetDate) & ")"

Else

strWhere = "(" & strDateField & " = " & Format(Me.txtStartDate, strcJetDate) & ")"

End If

If Nz(Me.txtStartDate, 0) = 0 And Nz(Me.txtEndDate, 0) = 0 Then strWhere = ""

'Close the report if already open: otherwise it won't filter properly.

' If CurrentProject.AllReports(strReport).IsLoaded Then

' DoCmd.Close acReport, strReport

' End If

'Open the report.

Debug.Print strWhere 'Remove the single quote from the start of this line for debugging purposes.

DoCmd.OpenReport strReport, lngView, , strWhere

Exit_Handler:

Exit Sub

Err_Handler:

If Err.Number <> 2501 Then

MsgBox "Error " & Err.Number & ": " & Err.Description, vbExclamation, "Cannot open report"

End If

Resume Exit_Handler

انت مبدع بحق ..... النتيجة راااااائعة

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

اسمح لى بسؤال اخير

اذا اردت ان اضع شرط اضافى فى النموذج بالاضافة الى حقلى التاريخ ، وهذا الشرط احصل عليه من combobox بقيمة 1 او 2 او 3

هل اعدل الكود بحيث يكون

DoCmd.OpenReport strReport, lngView, , strWhere , "Combo = " & Me.Combo

ام اضع تلك القيمة فى ال query

Form!MainForm!Combo

تقبل تحياتى

DoCmd.OpenReport strReport, lngView, , strWhere & "And" & "[combo]=" & Me!Combo

جرب الكود ده

مع ملاحظة أن:

[combo] حقل في الجدول له قيمة رقمية يستدل عليها من Me!Combo

شكرا لتعبك ... الكود يعمل بكفاءة مع ال COMBOBOX

ولكن يعطينى خطأ    Error 3075 عند عدم وجود بيانات بالحقلين txtStartDate ،  txtEndDate

انت ساحر

الكود يعمل بشكل طيب جدا وكما اريده تماما ....... الف شكر