Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

  • Congratulations Mike Lewis on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

Duplicate record on first run of labels

Status
Not open for further replies.

VicM

Programmer
Sep 24, 2001
444
US
Folks,

In the DB (Access 2010, .accdb) I was tasked to maintain, there is a report which prints out labels which fit a standard peel off label sheet of 3 across by 10 down.

When the report is first run, the 1st record(label) is repeated in the 2nd position across. But if the preview is closed before printing and rerun, that anomaly does not repeat and everything looks as it should.

I'm wondering if this is a bug in Access or if there could be something in the original report coding that I'm not seeing. It's strange that the second and subsequent times the report is run there is no duplication.

Any insights?

Thanks,
Vic
 
Hi Duane,

Sorry for delay in getting back.

Yes, there is code in the report. The report creates labels as mentioned. My boss at the time developed (or discovered, don't know which) a routine called label-saver.
Before the labels display in preview, the code asks how many labels of each you want (default is 1), and then also asks if there is an offset to the label sheet where you want to start printing. For instance, if you have a label sheet where the first 2 labels have been remove, you would enter a 3. The default is 1 also. Since basically all the time the labels are printed, they're printed on a full sheet so the user just selects the default values.

The report's Open sub, calls the label saver routines, which reside in their own module.

The open code and label saver codes are significant, and copying them into a code window here would require me to reformat many of the lines in order for them to fit into the code window so you could read them. It's unfortunate that the code window routine doesn't word wrap instead of truncating at the right.

Thanks,
Vic
 
I thought there might be code which would explain the issue. You can simply copy and paste the code into a reply here. Use the TGML Code tag to make it more readable.

Duane
Minnesota
Hook'D on Access
MS Access MVP 2001-2016
 
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
 
Status
Not open for further replies.

Part and Inventory Search

Sponsor

Back
Top