Printing selected reports from multi select list box

[ridders]

As part of a school database, I have a form to print reports showing class or
tutor group photos. In either case, the user selects from the available
groups using multi select list boxes.

All works fine for thee classes list box. However for the tutor group list,
it prints
multiple copies of the final item selected in the list. The number of copies
printed is equal to the number of items chosen. No other list selected is
printed.

I would be grateful for comments on where the problem is.

The codes used for each of the events is almost identical & I can't see
where the error is. I intend to clean up the code & eliminate duplication
once it all works correctly. Both sets of code listed below:

Firstly the tutor group code with the problem:
----------------------------------------------
Private Sub btnPrintTGpPhotos_Click()
On Error GoTo Err_btnPrintTGpPhotos_Click

''Bulk print tutor group photos after warning user that
'printing many classes may take a long time

'If no classes selected then Exit Sub
If Me.LstTutorGroups.ItemsSelected.Count = 0 Then
MsgBox "You have not selected a tutor group to print"
Exit Sub
End If

'Otherwise set up progress bar
intMaxLength = Me.boxProgressTop.Width
sngIncrement = intMaxLength / Me.LstTutorGroups.ItemsSelected.Count
Me.boxProgressTop.Width = 0

'Check & warn if more than 10 classes selected
If Me.LstTutorGroups.ItemsSelected.Count > 10 Then
Dim Msg, Style, Title, Response, MyString

Msg = "Printing many sets of photos at once may take a long time" &
vbNewLine & _
"Are you sure you want to continue?" & vbNewLine & vbNewLine & _
"Click YES to continue printing these tutor groups" & vbNewLine & _
"Click NO to return to the tutor group list"

Style = vbYesNo + vbInformation + vbDefaultButton2 ' Define buttons.
Title = "WARNING" ' Define title.
Response = MsgBox(Msg, Style, Title)
'If user chooses No, return to selection box.
If Response = vbNo Then Exit Sub
'If user chooses Yes, continue printing
End If

'Continue printing if Me.LstTutorGroups.ItemsSelected.Count is between 1 And
10
Set ctl = Forms!PrintClassPhotos.LstTutorGroups
stDocName = "rptTGpPhotos2"

intYear = LstTutorGroups.Column(1)
strTGp = LstTutorGroups.Column(2)

strSQL1 = "SELECT DISTINCTROW PupilData.PupilID, PupilData.Surname,
PupilData.Forename, TutorGroups.TutorGroup" & _
" FROM PupilData" & _
" WHERE PupilData.TutorGroup = ' & strTGp & ' AND PupilData.YearGroup =
' & intYear" & _
" ORDER BY PupilData.Surname, PupilData.Forename;"

For Each varItm In ctl.ItemsSelected

'Check if print preview selected
If Me.ChkPreview = True Then
DoCmd.OpenReport stDocName, acViewPreview, , "TutorGroup = '" & strTGp &
"'and YearGroup = " & intYear

'If not, show progress bar while printing
Else
Me.boxProgressBottom.Visible = True
Me.boxProgressTop.Visible = True
Me.LblPrinting.Visible = True
Me.LblPrinting.Caption = "Printing tutor group photos..."
Me.lblProgressCaption.Visible = True

If Me.boxProgressTop.Width < intMaxLength Then
DoEvents 'needed to let computer continue with other tasks
lblProgressCaption.ForeColor = vbBlack
Me.boxProgressTop.Width = (Me.boxProgressTop.Width + sngIncrement)
Me.Repaint
lblProgressCaption.Caption = Int(100 * (Me.boxProgressTop.Width /
intMaxLength)) & " %"
If Me.boxProgressTop.Width / intMaxLength > 0.55 Then
lblProgressCaption.ForeColor = vbYellow
DoCmd.OpenReport stDocName, acViewNormal, , "TutorGroup = '" & strTGp &
"'and YearGroup = " & intYear

End If
End If
Next varItm

'When printing complete, show message for 5 seconds
Me.LblPrinting.Caption = "Printing completed"
Dim PauseTime, Start, Finish
PauseTime = 5 ' Set duration.
Start = Timer ' Set start time.
Do While Timer < Start + PauseTime
DoEvents ' Yield to other processes.
Loop
Finish = Timer ' Set end time.

'Hide progress bar and reset Classes list/counter
Me.boxProgressBottom.Visible = False
Me.boxProgressTop.Visible = False
Me.lblProgressCaption.Visible = False
Me.LblPrinting.Visible = False
Me.LstTutorGroups.Requery
Me.txtTotalTG = 0

'Re-sort LstClasses by TeacherID
'Dim sort As Integer
'sort = basOrderby("TeacherID", "asc")

Exit Sub

Exit_btnPrintTGpPhotos_Click:
Exit Sub

Err_btnPrintTGpPhotos_Click:
MsgBox err.Description
Resume Exit_btnPrintTGpPhotos_Click

End Sub
---------------------------------------------
All variables defined in the form declarations:

-------------------------------------------
Option Compare Database
Option Explicit

Dim ControlName As String
Dim strselectionT As String
Dim strselection As String
Dim strSql As String

Dim ExitLoop As Boolean
Dim intMaxLength As Integer
Dim sngIncrement As Single
Dim stDocName As String

Dim ctl As Control
Dim varItm As Variant

Dim intYear As Integer
Dim strSQL1, strTGp As String

Dim sort As Integer

Dim lngC, lngTG As Long

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

For comparison, here is the code that works fine for class photos:

Private Sub btnPrintPhotos_Click()
On Error GoTo Err_btnPrintPhotos_Click

'Bulk print class photos after warning user that
'printing many classes may take a long time

'If no classes selected then Exit Sub
If Me.LstClasses.ItemsSelected.Count = 0 Then
MsgBox "You have not selected a set to print"
Exit Sub
End If

'Otherwise set up progress bar
intMaxLength = Me.boxProgressTop.Width
sngIncrement = intMaxLength / Me.LstClasses.ItemsSelected.Count
Me.boxProgressTop.Width = 0

'Check & warn if more than 10 classes selected
If Me.LstClasses.ItemsSelected.Count > 10 Then
Dim Msg, Style, Title, Response, MyString

Msg = "Printing many sets of photos at once may take a long time" &
vbNewLine & _
"Are you sure you want to continue?" & vbNewLine & vbNewLine & _
"Click YES to continue printing these classes" & vbNewLine & _
"Click NO to return to the list of classes"

Style = vbYesNo + vbInformation + vbDefaultButton2 ' Define buttons.
Title = "WARNING" ' Define title.
Response = MsgBox(Msg, Style, Title)
'If user chooses No, return to selection box.
If Response = vbNo Then Exit Sub
'If user chooses Yes, continue printing
End If

'Continue printing if Me.LstClasses.ItemsSelected.Count is between 1 And 10

Set ctl = Forms!PrintClassPhotos.LstClasses
stDocName = "rptClassPhotos"

For Each varItm In ctl.ItemsSelected
strClass = ctl.ItemData(varItm)

'Check if print preview selected
If Me.ChkPreview = True Then
DoCmd.OpenReport stDocName, acViewPreview, , "ClassID = '" & strClass & "'"

'If not, show progress bar while printing
Else
Me.boxProgressBottom.Visible = True
Me.boxProgressTop.Visible = True
Me.LblPrinting.Visible = True
Me.LblPrinting.Caption = "Printing class photos..."
Me.lblProgressCaption.Visible = True

If Me.boxProgressTop.Width < intMaxLength Then
DoEvents 'needed to let computer continue with other tasks
lblProgressCaption.ForeColor = vbBlack
Me.boxProgressTop.Width = (Me.boxProgressTop.Width + sngIncrement)
Me.Repaint
lblProgressCaption.Caption = Int(100 * (Me.boxProgressTop.Width /
intMaxLength)) & " %"
If Me.boxProgressTop.Width / intMaxLength > 0.55 Then
lblProgressCaption.ForeColor = vbYellow
DoCmd.OpenReport stDocName, acViewNormal, , "ClassID = '" & strClass & "'"

End If
End If
Next varItm

'When printing complete, show message for 5 seconds
Me.LblPrinting.Caption = "Printing completed"
Dim PauseTime, Start, Finish As Integer
PauseTime = 5 ' Set duration.
Start = Timer ' Set start time.
Do While Timer < Start + PauseTime
DoEvents ' Yield to other processes.
Loop
Finish = Timer ' Set end time.

'Hide progress bar and reset Classes list/counter
Me.boxProgressBottom.Visible = False
Me.boxProgressTop.Visible = False
Me.lblProgressCaption.Visible = False
Me.LblPrinting.Visible = False
Me.LstClasses.Requery
Me.txtTotalClass = 0

'Re-sort LstClasses by TeacherID
sort = basOrderby("TeacherID", "asc")

Exit Sub

Exit_btnPrintPhotos_Click:
Me.boxProgressBottom.Visible = False
Me.boxProgressTop.Visible = False
Me.lblProgressCaption.Visible = False
Me.LblPrinting.Visible = False
Me.LstClasses.Requery
Me.txtTotalClass = 0
Exit Sub

Err_btnPrintPhotos_Click:
MsgBox err.Description
Resume Exit_btnPrintPhotos_Click

End Sub

 

[Carl Rapson]

You're iterating through the selected items, but you're never referencing
the values of each selected item.
You set the values you're passing to the report with the lines

intYear = LstTutorGroups.Column(1)
strTGp = LstTutorGroups.Column(2)

outside of the For Each loop, and those values are never changing. That's
why the report prints the correct number of times but with the same values.
What you need to do is move those two lines inside the For Each loop, and
change them to be

intYear = LstTutorGroups.Column(1, varItm)
strTGp = LstTutorGroups.Column(2, varItm)

In your second example, you are correctly updating the desired value within
the For Each loop.

HTH,

Carl Rapson

 

[ridders]

Carl

Thanks ever so much.
The fault wasblindingly obvious with hindsight.
It all now works perfectly.

Cheers