Trying to have a button on a form open a report with info from a list box (1 Viewer)

[voltage]

I have been trying to wrap my head around this but I keep spinning my wheels and running into walls trying to get this to work.

So I inheritied this Access database from previous guy in this position, and I am trying to add a button to one of the forms in the file and have that button open a report with some speicific info.

So here is what teh form looks like, it is a employee schedule for the month basically. You can click any day on the calendar and in the list box above you get the duty roster for that day.

https://imgur.com/QibnNYQ

Here is the VBA code for that form and I have been trying to reverse engineer it so to speak. I understand that some of the blocks of code are for highlighting the current day or for stating the days in the month.

Private Sub PopulateCalendar()
On Error GoTo Err_PopulateCalendar
Dim strFirstOfMonth As String, bytFirstWeekdayOfMonth As Byte, bytBlockCounter As Byte
Dim bytBlockDayOfMonth As Byte, lngBlockDate As Long, ctlDayBlock As TextBox
Dim bytDaysInMonth As Byte, bytEventDayOfMonth As Byte, lngFirstOfMonth As Long
Dim lngLastOfMonth As Long, lngFirstOfNextMonth As Long, lngLastOfPreviousMonth As Long
Dim lngEventDate As Long, bytBlankBlocksBefore As Byte, bytBlankBlocksAfter As Byte
Dim astrCalendarBlocks(1 To 42) As String, db As DAO.Database, rstEvents As DAO.Recordset
Dim strEvent As String
Dim lngSystemDate As Long
Dim ctlSystemDateBlock As TextBox, blnSystemDateIsShown As Boolean
Dim strSQL As String
Dim lngFirstDateInRange As Long
Dim lngLastDateInRange As Long
Dim lngEachDateInRange As Long
Dim strStartTime As String

lngSystemDate = Date
intMonth = objCurrentDate.Month
intYear = objCurrentDate.Year
'lstEvents.Visible = False
'lblEventsOnDate.Visible = False
'lblEventsOn.Visible = True
lblMonth.Caption = MonthAndYear(intMonth, intYear)
strFirstOfMonth = Str(intMonth) & "/1/" & Str(intYear)

bytFirstWeekdayOfMonth = Weekday(strFirstOfMonth)
lngFirstOfMonth = DateSerial(intYear, intMonth, 1)
lngFirstOfNextMonth = DateSerial(intYear, intMonth + 1, 1)
lngLastOfMonth = lngFirstOfNextMonth - 1
lngLastOfPreviousMonth = lngFirstOfMonth - 1
bytDaysInMonth = lngFirstOfNextMonth - lngFirstOfMonth
bytBlankBlocksBefore = bytFirstWeekdayOfMonth - 1
bytBlankBlocksAfter = 42 - (bytBlankBlocksBefore + bytDaysInMonth)

    
Set db = CurrentDb

'If Me.cboEmployee > 0 Then

'strSQL = "SELECT tblLeaveDetail.Last, tblLeaveDetail.First, tblLeaveDetail.Date, tblLeaveDetail.Shift, tblLeaveCode.TypeID " & _
'         "FROM tblLeaveCode INNER JOIN tblLeaveDetail ON tblLeaveCode.TypeID = tblLeaveDetail.TypeID " & _
'         "WHERE tblLeaveDetail.Employee_ID = " & Me![cboEmployee] & " and tblLeaveDetail.Date Between " & lngFirstOfMonth & " And " & lngLastOfMonth & _
'         " ORDER BY tblLeaveDetail.Shift, tblLeaveCode.TypeID, tblLeaveDetail.Last, tblLeaveDetail.First;"
 
If Me.cboShift = " " Then

strSQL = "SELECT tblLeaveDetail.Last, tblLeaveDetail.First, tblLeaveDetail.Date, tblLeaveDetail.Shift, tblLeaveCode.TypeID " & _
         "FROM tblLeaveCode INNER JOIN tblLeaveDetail ON tblLeaveCode.TypeID = tblLeaveDetail.TypeID " & _
         "WHERE tblLeaveCode.TypeID <> ""W"" and tblLeaveCode.TypeID <> ""SA"" and tblLeaveCode.TypeID <> ""OT"" and tblLeaveCode.TypeID <> ""BB"" and tblLeaveCode.TypeID <> ""F"" and tblLeaveDetail.Date Between " & lngFirstOfMonth & " And " & lngLastOfMonth & _
         " ORDER BY tblLeaveDetail.Shift, tblLeaveCode.TypeID, tblLeaveDetail.Last, tblLeaveDetail.First;"

Else

strSQL = "SELECT tblLeaveDetail.Last, tblLeaveDetail.First, tblLeaveDetail.Date, tblLeaveDetail.Shift, tblLeaveCode.TypeID " & _
         "FROM tblLeaveCode INNER JOIN tblLeaveDetail ON tblLeaveCode.TypeID = tblLeaveDetail.TypeID " & _
         "WHERE tblLeaveDetail.Shift =  """ & Me![cboShift] & """ and tblLeaveCode.TypeID <> ""W"" and tblLeaveCode.TypeID <> ""SA"" and tblLeaveCode.TypeID <> ""OT"" and tblLeaveCode.TypeID <> ""BB"" and tblLeaveCode.TypeID <> ""F"" and tblLeaveDetail.Date Between " & lngFirstOfMonth & " And " & lngLastOfMonth & _
         " ORDER BY tblLeaveDetail.Shift, tblLeaveCode.TypeID, tblLeaveDetail.Last, tblLeaveDetail.First;"
End If

Set rstEvents = db.OpenRecordset(strSQL)

Do While Not rstEvents.EOF
 
  lngFirstDateInRange = rstEvents![Date]      '<Substitute for [Start Date]>
  If lngFirstDateInRange < lngFirstOfMonth Then
    lngFirstDateInRange = lngFirstOfMonth
  End If
  lngLastDateInRange = rstEvents![Date]         '<Substitute for [End Date]>
  If lngLastDateInRange > lngLastOfMonth Then
    lngLastDateInRange = lngLastOfMonth
  End If
 
  For lngEachDateInRange = lngFirstDateInRange To lngLastDateInRange
    bytEventDayOfMonth = (lngEachDateInRange - lngLastOfPreviousMonth)
    bytBlockCounter = bytEventDayOfMonth + bytBlankBlocksBefore
                                              '<Substitute for [Title]>
      If astrCalendarBlocks(bytBlockCounter) = "" Then
        astrCalendarBlocks(bytBlockCounter) = "[" & rstEvents![TypeID] & "]  " & rstEvents![Last] & ", " & Left$(rstEvents![First], 1) & "."
      Else                                    '<Substitute for [Title]>
        astrCalendarBlocks(bytBlockCounter) = astrCalendarBlocks(bytBlockCounter) & vbNewLine & _
                                              "[" & rstEvents![TypeID] & "]  " & rstEvents![Last] & ", " & Left$(rstEvents![First], 1) & "."
                                              
      End If
  Next lngEachDateInRange
 
 
    rstEvents.MoveNext
Loop
    
For bytBlockCounter = 1 To 42                           'blank blocks at start of month
  Select Case bytBlockCounter
    Case Is < bytFirstWeekdayOfMonth
      astrCalendarBlocks(bytBlockCounter) = ""
      ReferenceABlock ctlDayBlock, bytBlockCounter
      'ctlDayBlock.BackColor = 12632256
      ctlDayBlock.BackColor = RGB(22, 34, 82)
      ctlDayBlock = ""
      ctlDayBlock.Enabled = False
      ctlDayBlock.Tag = ""
    Case Is > bytBlankBlocksBefore + bytDaysInMonth     'blank blocks at end of month
      astrCalendarBlocks(bytBlockCounter) = ""
      ReferenceABlock ctlDayBlock, bytBlockCounter
      'ctlDayBlock.BackColor = 12632256
      ctlDayBlock.BackColor = RGB(22, 34, 82)
      ctlDayBlock = ""
      ctlDayBlock.Enabled = False
      ctlDayBlock.Tag = ""
        ctlDayBlock.Visible = Not (bytBlankBlocksAfter > 6 And bytBlockCounter > 35)
    Case Else   'blocks that hold days of the month
      bytBlockDayOfMonth = bytBlockCounter - bytBlankBlocksBefore
      ReferenceABlock ctlDayBlock, bytBlockCounter
      lngBlockDate = lngLastOfPreviousMonth + bytBlockDayOfMonth 'block's date
        If bytBlockDayOfMonth < 10 Then
          ctlDayBlock = Space(2) & bytBlockDayOfMonth & _
                        vbNewLine & astrCalendarBlocks(bytBlockCounter)
        Else
          ctlDayBlock = bytBlockDayOfMonth & _
                        vbNewLine & astrCalendarBlocks(bytBlockCounter)
        End If
        
        
            
        'If this block is the system date, change its color (CFB 1-25-08)
        If lngBlockDate = lngSystemDate Then
          ctlDayBlock.BackColor = 11206655
          ctlDayBlock.ForeColor = 0
          Set ctlSystemDateBlock = ctlDayBlock
          blnSystemDateIsShown = True
        Else
          ctlDayBlock.BackColor = RGB(242, 242, 242)
          ctlDayBlock.ForeColor = 0
        End If
          ctlDayBlock.Visible = True
          ctlDayBlock.Enabled = True
          ctlDayBlock.Tag = lngBlockDate
          
        
                
  End Select
Next
 
'If the system date is in this month, show its events
If blnSystemDateIsShown Then
  PopulateEventsList ctlSystemDateBlock
End If
    
Call PopulateYearListBox

Exit_PopulateCalendar:
  Exit Sub
Err_PopulateCalendar:
  MsgBox Err.Description, vbExclamation, "Error in PopulateCalendar()"
  Call LogErrors(Err.Number, Err.Description, "frmCalendar", "PopulateCalendar() Sub-Routine", "Called from Multiple Locations")
    Resume Exit_PopulateCalendar
End Sub

So I have the button place and have the following code for the "OnClick" event for the button:

Private Sub Command93_Click()

Dim i As Integer

For i = 0 To Me.lstEvents.ListCount - 1
    DoCmd.OpenReport "rptDailyETSB"

Next i

End Sub

But when i click the button it just trys to send dozens of print jobs to the printer and I have to frantically click cancel several times. How do I go about having that button when clicked, opening the report and populating the report with whatever is in the list box on the form at the time, or putting whatever is in that list box, into another list box on the report?

 

[pbaldy]

Does this help?

Multi-Select Listbox

 

[LarryE]

It's just:
DoCmd.OpenReport "rptDailyETSB", using your filtering citeria
I don't know what

Dim i As Integer
For i = 0 To Me.lstEvents.ListCount - 1
    DoCmd.OpenReport "rptDailyETSB"
Next i

is supposed to do but it appears Me.1stEvents is some sort of list of something, so the code is opening the report numerous times.

 

[voltage]

So I tried just having:
DoCmd.OpenReport "rptDailyETSB"

for the onclick event of that button and all it does now is act like it is sending a print job to the printer although nothing ever prints out and the report doesn't come up on the screen.

 

[voltage]

Does this help?

hmm that is interesting, although mine isn't a selection, it's just a click a date and get all employees that day working sent to the list box at the top. I know that this is generating that info in some form:

strSQL = "SELECT tblLeaveDetail.Last, tblLeaveDetail.First, tblLeaveDetail.Date, tblLeaveDetail.Shift, tblLeaveCode.TypeID " & _
         "FROM tblLeaveCode INNER JOIN tblLeaveDetail ON tblLeaveCode.TypeID = tblLeaveDetail.TypeID " & _
         "WHERE tblLeaveCode.TypeID <> ""W"" and tblLeaveCode.TypeID <> ""SA"" and tblLeaveCode.TypeID <> ""OT"" and tblLeaveCode.TypeID <> ""BB"" and tblLeaveCode.TypeID <> ""F"" and tblLeaveDetail.Date Between " & lngFirstOfMonth & " And " & lngLastOfMonth & _
         " ORDER BY tblLeaveDetail.Shift, tblLeaveCode.TypeID, tblLeaveDetail.Last, tblLeaveDetail.First;"

But there are a few statements with that in teh block, and not sure what is doing what. Also not sure what these Me statements are doing

 

[Gasman]

If you want one ŕeport for each entry in the listbox, then you need to provide criteria for each.
If you want one report for all then youneed to concatenate the selected, then use that as criteria. If you use print preview you can then decide whether you want to print it or not.

 

[LarryE]

So I tried just having:
DoCmd.OpenReport "rptDailyETSB"

for the onclick event of that button and all it does now is act like it is sending a print job to the printer although nothing ever prints out and the report doesn't come up on the screen.

Well you need to complete the rest of the command criteria too. I thought you knew that. Sorry.
DoCmd.OpenReport method (Access) | Microsoft Learn

 

[Gasman]

One report

Private Sub cmdReport_Click()
On Error GoTo Err_Handler
'Dim db As DAO.Database
'Dim qdf As DAO.QueryDef
Dim ctl As Control
Dim varItem As Variant
Dim strParam As String, strRptQuery As String

'First validate we have all the data we need
If IsNull(Me.cboEmployeeID) Then
    MsgBox ("Employee is mandatory")
    Me.cboEmployeeID.SetFocus
    Exit Sub
End If
If IsNull(Me.txtStartdate) Then
    MsgBox ("Start date is mandatory")
    Exit Sub
End If
If IsNull(Me.txtEnddate) Then
    MsgBox ("End date is mandatory")
    Exit Sub
End If
   
strRptQuery = "qryEmployeeHours"
Set ctl = Me!lstDayType
'Open the report with an OpenArgs value to get selected hours for employee
' Now select what type of day records from listbox
If ctl.ItemsSelected.Count > 0 Then
    For Each varItem In ctl.ItemsSelected
        strParam = strParam & ctl.ItemData(varItem) & ","
    Next varItem
  Else
    MsgBox ("At least one Day Type is required")
    Exit Sub
End If

' Need to pass the criteria as a string
strParam = " IN (" & Left(strParam, Len(strParam) - 1) & ")"
'Debug.Print strParam
'Set db = CurrentDb
'Set qdf = db.QueryDefs(strRptQuery)
'qdf.Parameters("pInList") = strParam
'qdf.Close

strParam = "[DateType]" & strParam
DoCmd.OpenReport "rptHours", acViewReport, , strParam, , "Selected"
'docmd.OpenReport "tt",acViewPreview,,"[DateType]=15",,,

Exit_Sub:
    Set ctl = Nothing
    'Set db = Nothing
    'Set qdf = Nothing

Err_Exit:
    Exit Sub
    
Err_Handler:
    MsgBox "Error " & Err.Number & " " & Err.Description
    Resume Exit_Sub
End Sub

 

[voltage]

So am I able to reference the names of list boxes from forms on the report? I tried to do a

Me.lstEvents.ListCount - 1

in the code on teh report

As lstEvents is the name of the list box on the form, but I get a compile error: Method or data memeber not found and it takes me to that lstevents in the Me statement on my report

 

[June7]

Me is shorthand for name of object code is behind. If you want to reference form control in report VBA, use the form path reference:

Forms!formname.lstEvents.ListCount

 

[moke123]

Whats the rowsource of the listbox?

 

[voltage]

Whats the rowsource of the listbox?

Row Source of the list box is:

SELECT tblLeaveDetail.Shift, tblLeaveDetail.District, tblLeaveDetail.Employee_ID as Star, [tblLeaveDetail.Last] & ', ' & [tblLeaveDetail.First] as Deputy, tblLeaveCode.Type, tblLeaveDetail.Hours, tblLeaveDetail.Remarks FROM tblLeaveCode INNER JOIN tblLeaveDetail ON tblLeaveCode.TypeID = tblLeaveDetail.TypeID WHERE tblLeaveDetail.Shift = "1" and tblLeaveCode.TypeID IN ('W','OT','F') and tblLeaveDetail.Date = 42038 ORDER BY tblLeaveDetail.Shift, tblLeaveDetail.District, tblLeaveDetail.Last, tblLeaveDetail.First;

 

[mike60smart]

You need something along these lines:-

DoCmd.OutputTo acOutputReport, "rptDailyETSB", acFormatPDF, "C:\Reports\" & Format(Date, "yyyymmdd") & ".pdf", False

 

[pbaldy]

I'm not sure I understand the goal, but what about setting the source of the report to the source of the listbox? That could be done by passing the SQL in OpenArgs or just having code in the report's open event grab it from the listbox. I'd probably to with OpenArgs to be more flexible.

 

[Gasman]

I have already shown you one way?, use the selected items in the listbox as criteria in the Where clause of the OpenReport command.

 

[moke123]

I'm not sure I understand the goal, but what about setting the source of the report to the source of the listbox? That could be done by passing the SQL in OpenArgs or just having code in the report's open event grab it from the listbox. I'd probably to with OpenArgs to be more flexible.

That's what I was getting at with my question. I was also a little fuzzy as far as the requirement.

here's an example that passes the list box row source to the report.

 

[pbaldy]

I have already shown you one way?, use the selected items in the listbox as criteria in the Where clause of the OpenReport command.

I posted similar code in post 2, OP explained why it wasn't appropriate in post 5.

 

[Gasman]

I posted similar code in post 2, OP explained why it wasn't appropriate in post 5.

Not understanding why, after the OP has populated that list, he cannot then use that as the criteria?

 

[moke123]

Not understanding why, after the OP has populated that list, he cannot then use that as the criteria?

He can.

DoCmd.OpenReport "report1", acViewReport, , , , Me.List0.RowSource

Private Sub Report_Load()

    If Nz(Me.OpenArgs, "") <> "" Then
        Me.RecordSource = Me.OpenArgs
    Else
        'do something here if you want
    End If

End Sub