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

voltage

New member
Local time
Today, 01:40
Joined
Jul 28, 2023
Messages
5
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.

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.

Code:
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:

Code:
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?
 

LarryE

Active member
Local time
Yesterday, 23:40
Joined
Aug 18, 2021
Messages
612
It's just:
DoCmd.OpenReport "rptDailyETSB", using your filtering citeria
I don't know what
Code:
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.
 
Last edited:

voltage

New member
Local time
Today, 01:40
Joined
Jul 28, 2023
Messages
5
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

New member
Local time
Today, 01:40
Joined
Jul 28, 2023
Messages
5
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:

Code:
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

Enthusiastic Amateur
Local time
Today, 07:40
Joined
Sep 21, 2011
Messages
14,528
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.
 
Last edited:

LarryE

Active member
Local time
Yesterday, 23:40
Joined
Aug 18, 2021
Messages
612
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

Enthusiastic Amateur
Local time
Today, 07:40
Joined
Sep 21, 2011
Messages
14,528
One report
Code:
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

New member
Local time
Today, 01:40
Joined
Jul 28, 2023
Messages
5
So am I able to reference the names of list boxes from forms on the report? I tried to do a
Code:
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

AWF VIP
Local time
Yesterday, 22:40
Joined
Mar 9, 2014
Messages
5,501
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
 

voltage

New member
Local time
Today, 01:40
Joined
Jul 28, 2023
Messages
5
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

Registered User.
Local time
Today, 07:40
Joined
Aug 6, 2017
Messages
1,917
You need something along these lines:-

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

pbaldy

Wino Moderator
Staff member
Local time
Yesterday, 23:40
Joined
Aug 30, 2003
Messages
36,137
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

Enthusiastic Amateur
Local time
Today, 07:40
Joined
Sep 21, 2011
Messages
14,528
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

AWF VIP
Local time
Today, 02:40
Joined
Jan 11, 2013
Messages
3,952
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.
 

Attachments

  • lbxRpt.accdb
    500 KB · Views: 67

pbaldy

Wino Moderator
Staff member
Local time
Yesterday, 23:40
Joined
Aug 30, 2003
Messages
36,137
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. :rolleyes:
 

Gasman

Enthusiastic Amateur
Local time
Today, 07:40
Joined
Sep 21, 2011
Messages
14,528
I posted similar code in post 2, OP explained why it wasn't appropriate in post 5. :rolleyes:
Not understanding why, after the OP has populated that list, he cannot then use that as the criteria? :(
 

moke123

AWF VIP
Local time
Today, 02:40
Joined
Jan 11, 2013
Messages
3,952
Not understanding why, after the OP has populated that list, he cannot then use that as the criteria?
He can.

Code:
DoCmd.OpenReport "report1", acViewReport, , , , Me.List0.RowSource
Code:
Private Sub Report_Load()

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

End Sub
 

Users who are viewing this thread

Top Bottom