Duane,
The first set of code is from the report itself.
Private Sub Report_Open(Cancel As Integer)
Dim sql As String
Dim Edat As Date
Dim compy As Integer
'OpenArgs contains a date which is required in one of the WHERE clauses of the SELECT statement
If Len(Me.OpenArgs) > 2 Then
Edat = CDate(Right(Me.OpenArgs, 10))
If Forms!frmBallotList.cbEmployers <> 9 Then GoTo byEmployer
sql = "SELECT (tblMembers.MemFName & ' ' & tblMembers.MemLName) AS MemName, tblMembers.MemAddress1, tblMembers.MemAddress2, tblMembers.MemCity, " & _
"tblMembers.MemST, tblMembers.MemZipcode, tblAltEmpInfo.fldAltAddr1, tblAltEmpInfo.fldAltAddr2, tblAltEmpInfo.fldAltCity, tblAltEmpInfo.fldAltState, " & _
"tblAltEmpInfo.fldAltZip, IIf(Len(tblAltEmpInfo.fldAltAddr1) > 0, tblAltEmpInfo.fldAltZip, tblMembers.MemZipcode) as TruZip " & _
"FROM tblMembers INNER JOIN tblAltEmpInfo ON tblMembers.MemPRIID = tblAltEmpInfo.PriID " & _
"WHERE (((tblMembers.MemStatusID)=17 Or (tblMembers.MemStatusID)=2) AND ((tblMembers.MemMemberTypeID)=3 Or (tblMembers.MemMemberTypeID)=6) AND ((tblMembers.MemClassID)<>8 And (tblMembers.MemClassID)<>14 And (tblMembers.MemClassID)<>15)) AND tblMembers.Mem_UnitNo <> 999 OR (((tblMembers.MemStatusID)=20 Or (tblMembers.MemStatusID)=21) AND ((tblMembers.MemMemberTypeID)=3 Or (tblMembers.MemMemberTypeID)=6) AND ((tblMembers.MemClassID)<>8 And (tblMembers.MemClassID)<>14 And (tblMembers.MemClassID)<>15) AND ((tblMembers.MemEffective)>= #" & Edat - 90 & "#)) AND tblMembers.Mem_UnitNo <> 999 AND tblMembers.HideRec = False " & _
"ORDER BY IIf(Len(tblAltEmpInfo.fldAltAddr1) > 0, tblAltEmpInfo.fldAltZip, tblMembers.MemZipcode), tblMembers.MemLName, tblMembers.Mem_UnitNo, tblMembers.MemFName;"
Me.RecordSource = sql
ls_ReportOnOpen Me, Cancel 'Label Saver
DoCmd.Maximize
Exit Sub
byEmployer:
compy = Forms!frmBallotList.cbEmployers.Value
sql = "SELECT (tblMembers.MemFName & ' ' & tblMembers.MemLName) AS MemName, tblMembers.MemAddress1, " & _
"tblMembers.MemAddress2, tblMembers.MemCity, tblMembers.MemST, tblMembers.MemZipcode, tblAltEmpInfo.fldAltAddr1, tblAltEmpInfo.fldAltAddr2, tblAltEmpInfo.fldAltCity, tblAltEmpInfo.fldAltState, " & _
"tblAltEmpInfo.fldAltZip, IIf(Len(tblAltEmpInfo.fldAltAddr1)>0,tblAltEmpInfo.fldAltZip,tblMembers.MemZipcode) AS TruZip " & _
"FROM tblMembers INNER JOIN tblAltEmpInfo ON tblMembers.MemPRIID = tblAltEmpInfo.PriID " & _
"WHERE (((tblMembers.Mem_UnitNo)<>999) AND ((tblMembers.MemStatusID)=17 Or (tblMembers.MemStatusID)=2)) AND " & _
"((tblMembers.MemMemberTypeID)=3 Or (tblMembers.MemMemberTypeID)=6) AND ((tblMembers.MemClassID)<>8 And " & _
"(tblMembers.MemClassID)<>14 And (tblMembers.MemClassID)<>15) AND ((tblMembers.MemEmp)=" & compy & ") AND ((tblMembers.HideRec)=False) " & _
"OR (((tblMembers.Mem_UnitNo)<>999) AND ((tblMembers.MemStatusID)=20 Or (tblMembers.MemStatusID)=21) AND " & _
"((tblMembers.MemMemberTypeID)=3 Or (tblMembers.MemMemberTypeID)=6) AND ((tblMembers.MemClassID)<>8 And (tblMembers.MemClassID)<>14 And (tblMembers.MemClassID)<>15) " & _
"AND ((tblMembers.MemEffective)>=" & Edat & "-90) AND ((tblMembers.MemEmp)=" & compy & ") AND ((tblMembers.HideRec)=False))" & _
"ORDER BY IIf(Len(tblAltEmpInfo.fldAltAddr1)>0,tblAltEmpInfo.fldAltZip,tblMembers.MemZipcode), tblMembers.MemLName, tblMembers.Mem_UnitNo, tblMembers.MemFName;"
MsgBox "Ballot labels for " & Forms!frmBallotList.cbEmployers.Column(1), vbOKOnly, "Employer Only Labels"
Me.RecordSource = sql
ls_ReportOnOpen Me, Cancel 'Label Saver
DoCmd.Maximize
Exit Sub
Else
FillTruAddy 'TruAddy is a make-table query that selects the names and addresses for the mailing labels
Me.RecordSource = "SELECT * FROM tblTruAddy"
ls_ReportOnOpen Me, Cancel 'Label Saver
End If
DoCmd.Maximize
End Sub
This next set of code is from the label saver module.
Option Compare Database
Option Explicit
' Usage:
' LS_Init - from your label report's report header OnFormat event procedure
' (create a label report header if you don't have one already. Set
' the report header section height to 0.)
' LS_ReportOnOpen Me, Cancel - from your label report's OnOpen event procedure, and
' LS_DetailOnPrint Me - from your label report's Detail OnPrint event procedure.
'
'Module variables
Dim iLSBlankRecordsToPrint As Integer
Dim iLSBlankCount As Integer
Dim iLSCopiesToPrint As Integer
Dim iLSCopiesCount As Integer
Sub ls_DetailOnPrint(rpt As Report)
'Print a specified number of blank detail sections.
On Error GoTo ls_DetailOnPrint_err
If iLSBlankCount < iLSBlankRecordsToPrint Then
'Leave a blank detail section without skipping a record
rpt.NextRecord = False
rpt.PrintSection = False
iLSBlankCount = iLSBlankCount + 1
Else
If iLSCopiesCount < iLSCopiesToPrint Then
rpt.NextRecord = False
iLSCopiesCount = iLSCopiesCount + 1
Else
iLSCopiesCount = 1
End If
End If
ls_DetailOnPrint_exit:
Exit Sub
ls_DetailOnPrint_err:
MsgBox "Error in Label Saver subroutine ls_DetailOnPrint - " & Err & " - " & Err.Description
GoTo ls_DetailOnPrint_exit
End Sub
Sub ls_Init()
iLSBlankCount = 0
iLSCopiesCount = 1
End Sub
Sub ls_ReportOnOpen(rpt As Report, ByRef Cancel As Integer)
'Prompts user for a label printing start position, and a number of copies.
'Sets variables for the OnFormat event procedure to handle
Dim iStartLabel As Integer
Dim iCopies As Integer
Dim vResp As Variant
On Error GoTo ls_ReportOnOpen_err
'Prompt user for starting label position
vResp = InputBox("Start at which label?", "Label Saver", 1)
If vResp = "" Then
'Cancel was clicked
Cancel = True
GoTo ls_ReportOnOpen_exit
End If
iStartLabel = CInt(vResp)
'Validation check
If iStartLabel >= 1 And iStartLabel <= 400 Then
Else
MsgBox "Starting label must be between 1 and 400." & vbCrLf & vbCrLf & " Labels/Report cancelled"
Cancel = True
GoTo ls_ReportOnOpen_exit
End If
'Prompt user for number of copies
vResp = InputBox("How many copies of each label?", "Label Saver", 1)
If vResp = "" Then
'Cancel was clicked
Cancel = True
GoTo ls_ReportOnOpen_exit
End If
iCopies = CInt(vResp)
'Validation check
If iCopies < 1 Then
MsgBox "Number of copies must be greater than 0." & vbCrLf & vbCrLf & " Labels/Report cancelled"
Cancel = True
GoTo ls_ReportOnOpen_exit
Else
If iCopies >= 1 And iCopies <= 100 Then
Else
If MsgBox("Are you sure you want to print " & iCopies & " copies of each label?", vbYesNo, "Label Saver") = vbYes Then
Else
MsgBox "Labels/Report cancelled"
Cancel = True
GoTo ls_ReportOnOpen_exit
End If
End If
End If
'Set variables. These are used in the Report Detail OnFormat event procedure
iLSBlankRecordsToPrint = iStartLabel - 1
iLSCopiesToPrint = iCopies
ls_ReportOnOpen_exit:
Exit Sub
ls_ReportOnOpen_err:
MsgBox "Error in Label Saver subroutine ls_ReportOnOpen - " & Err & " - " & Err.Description
GoTo ls_ReportOnOpen_exit
End Sub