Solved Printing Labels

mike60smart

mike60smart

Registered User.
Local time
Today, 00:15
Joined
Aug 6, 2017
Messages
2,241
Hi Everyone

I am trying to use the Code from this Site

When I create the OnClick Event the code shows lines 80 & 130 highlighted in Red ?

Can anyone see where it is wrong?

Any help appreciated

Code: 
Private Sub cmdPrint_Click()
10        On Error GoTo cmdPrint_Click_Error
      'Print multiple labels for current record.
      Dim i As Integer
      Dim rst As ADODB.Recordset
20    Set rst = New ADODB.Recordset
      'Delete previous label data.
30    DoCmd.SetWarnings False
40    DoCmd.RunSQL "DELETE FROM [tblLabels]"
50    DoCmd.SetWarnings True
60    On Error GoTo errHandler
      'Catch blank control.
      'If set to 0, label report is blank but runs.
70    If IsNull(Me!txtNumberOfLabels) Then
80    MsgBox "Please indicate the number of labels you want to print", _
90    vbOKOnly , "Error"
100   DoCmd.GoToControl "txtNumberOfLabels"
110   Exit Sub
120   End If
130   rst.Open "[Temporary Customers]", CurrentProject.Connection, adOpenDynamic, _ adLockPessimistic
      'Adds duplicate records for selected company using input value.
140   For i = 1 To Me!txtNumberOfLabels.Value
150   With rst
160   .AddNew
      '!BoxNr = Me.CustomerID
170   !CROP = Me.txtCrop
180   !Variety = Me.txtVariety
190   !Gen = Me.txtGen
200   !Line = Me.txtLine
210   !NetWeight = Me.txtWeight
220   !Customer = Me.txtCustomer
      '!PackNo = Me.Country
230   !Dessicated = Me.txtDessicated
240   !HarvestedFrom = Me.txtHarvestedFrom
      '!LabelNo = Me.Country
250   .Update
260   End With
270   Next i
      'Opens report.
280   DoCmd.OpenReport "Customer Label Report", acViewPreview
290   rst.Close
300   Set rst = Nothing
310   Exit Sub
      'Error handling routine.
errHandler:
320   MsgBox Err.Number & ": " & Err.Description, vbOKOnly, "Error"
330   DoCmd.SetWarnings True
340   rst.Close
350   Set rst = Nothing
360       On Error GoTo 0
370       Exit Sub
cmdPrint_Click_Error:
380       MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure cmdPrint_Click, line " & Erl & "."
End Sub
 
Waste of time using code tags with indentation like that? :(
 
mike60smart said:
Hi Moke

I don't know what you mean by "Continuation Lines" ??
Click to expand...
PMFJI,
Continuation lines are when the code goes over one line.
When that happens you put _ at the end of the line to indicate that the code continues.
Whilst 80 looks correct, it is not, so put that all on one line.
For 130 you have it, yet the line is not continued? :( , so remove it from that line.
 
Gasman said:
PMFJI,
Continuation lines are when the code goes over one line.
When that happens you put _ at the end of the line to indicate that the code continues.
Whilst 80 looks correct, it is not, so put that all on one line.
For 130 you have it, yet the line is not continued? :( , so remove it from that line.
Click to expand...
Hi Gasman

Great that fixed those errors.

When I run the code I now get the following error?
 

Attachments

  • error.PNG
    error.PNG
    27.5 KB · Views: 258
So you do not have the ado reference set?
 

Attachments

  • error.PNG
    error.PNG
    5.1 KB · Views: 245
  • error2.PNG
    error2.PNG
    6 KB · Views: 235
  • Line330.PNG
    Line330.PNG
    8.4 KB · Views: 230
Mike,
You have to say on what line the errors occur. :(
I have not played around with adodb, always used dao.
The first error should be evident you are referencing something that doesn't exist, probably in that recordset?
 
The 3219 error may be that your trying to close a closed recordset.
Line 40 and 130 look wrong. shouldn't they be the same tables?

This looks to be a relatively simple procedure. Why not re-write it with dao?

Write a record to a temp table whatever number of times to correspond to the number of labels needed.
Open a report with the labels.

along the lines of: (untested air code)

Code: 
Private Sub cmdPrint_Click()
  
    Dim db As DAO.Database
    Dim rs As DAO.Recordset
    Set db = CurrentDb


    db.Execute "Delete * from tblLabels", dbFailOnError


  
    'Print multiple labels for current record.
    Dim i As Integer
      
    If IsNull(Me!txtNumberOfLabels) Then
        MsgBox "Please indicate the number of labels you want to print", vbOKOnly, "Error"
        DoCmd.GoToControl "txtNumberOfLabels"
        Exit Sub
    End If
    
    Set rs = db.OpenRecordset("Select * from tblLabels")


    'Adds duplicate records for selected company using input value.
    For i = 1 To Me!txtNumberOfLabels.Value
        With rs
            .AddNew
            '!BoxNr = Me.CustomerID
            !CROP = Me.txtCrop
            !Variety = Me.txtVariety
            !Gen = Me.txtGen
            !Line = Me.txtLine
            !NetWeight = Me.txtWeight
            !Customer = Me.txtCustomer
            '!PackNo = Me.Country
            !Dessicated = Me.txtDessicated
            !HarvestedFrom = Me.txtHarvestedFrom
            '!LabelNo = Me.Country
            .Update
        End With
    Next i
    'Opens report.
    DoCmd.OpenReport "Customer Label Report", acViewPreview
    
    rs.Close
    Set rs = Nothing


End Sub
 
TBH, I would have just used a query wth a Cartesian join, that @arnelgp (and others probably) have described in the past.
No need for deleting/creating records which just cause bloat in Access.
Not sure what repeated queries do, but it must be less if anything?

Code: 
SELECT Transactions.*, Transactions.ID, tblRepeat.RepeatNumber
FROM Transactions, tblRepeat
WHERE (((Transactions.ID)=4) AND ((tblRepeat.RepeatNumber)<=5));
 
Last edited:
moke123 said:
The 3219 error may be that your trying to close a closed recordset.
Line 40 and 130 look wrong. shouldn't they be the same tables?

This looks to be a relatively simple procedure. Why not re-write it with dao?

Write a record to a temp table whatever number of times to correspond to the number of labels needed.
Open a report with the labels.

along the lines of: (untested air code)

Code: 
Private Sub cmdPrint_Click()
 
    Dim db As DAO.Database
    Dim rs As DAO.Recordset
    Set db = CurrentDb


    db.Execute "Delete * from tblLabels", dbFailOnError


 
    'Print multiple labels for current record.
    Dim i As Integer
     
    If IsNull(Me!txtNumberOfLabels) Then
        MsgBox "Please indicate the number of labels you want to print", vbOKOnly, "Error"
        DoCmd.GoToControl "txtNumberOfLabels"
        Exit Sub
    End If
   
    Set rs = db.OpenRecordset("Select * from tblLabels")


    'Adds duplicate records for selected company using input value.
    For i = 1 To Me!txtNumberOfLabels.Value
        With rs
            .AddNew
            '!BoxNr = Me.CustomerID
            !CROP = Me.txtCrop
            !Variety = Me.txtVariety
            !Gen = Me.txtGen
            !Line = Me.txtLine
            !NetWeight = Me.txtWeight
            !Customer = Me.txtCustomer
            '!PackNo = Me.Country
            !Dessicated = Me.txtDessicated
            !HarvestedFrom = Me.txtHarvestedFrom
            '!LabelNo = Me.Country
            .Update
        End With
    Next i
    'Opens report.
    DoCmd.OpenReport "Customer Label Report", acViewPreview
   
    rs.Close
    Set rs = Nothing


End Sub
Click to expand...
Hi Moke

I tried your Code and it works perfectly but it only produces 1 Label.

How can the code be amended so that it produces the number of Labels specified in the Control txtNumberOfLabels ??
 
Moke's code would not do that?
Have you even walked through the code?
 
moke123 said:
The 3219 error may be that your trying to close a closed recordset.
Line 40 and 130 look wrong. shouldn't they be the same tables?

This looks to be a relatively simple procedure. Why not re-write it with dao?

Write a record to a temp table whatever number of times to correspond to the number of labels needed.
Open a report with the labels.

along the lines of: (untested air code)

Code: 
Private Sub cmdPrint_Click()
 
    Dim db As DAO.Database
    Dim rs As DAO.Recordset
    Set db = CurrentDb


    db.Execute "Delete * from tblLabels", dbFailOnError


 
    'Print multiple labels for current record.
    Dim i As Integer
     
    If IsNull(Me!txtNumberOfLabels) Then
        MsgBox "Please indicate the number of labels you want to print", vbOKOnly, "Error"
        DoCmd.GoToControl "txtNumberOfLabels"
        Exit Sub
    End If
   
    Set rs = db.OpenRecordset("Select * from tblLabels")


    'Adds duplicate records for selected company using input value.
    For i = 1 To Me!txtNumberOfLabels.Value
        With rs
            .AddNew
            '!BoxNr = Me.CustomerID
            !CROP = Me.txtCrop
            !Variety = Me.txtVariety
            !Gen = Me.txtGen
            !Line = Me.txtLine
            !NetWeight = Me.txtWeight
            !Customer = Me.txtCustomer
            '!PackNo = Me.Country
            !Dessicated = Me.txtDessicated
            !HarvestedFrom = Me.txtHarvestedFrom
            '!LabelNo = Me.Country
            .Update
        End With
    Next i
    'Opens report.
    DoCmd.OpenReport "Customer Label Report", acViewPreview
   
    rs.Close
    Set rs = Nothing


End Sub
Click to expand...
Hi Moke
The Code runs just great and the tblLabels contains the correct 10 Labels for the Record selected on my Form but it only produces 1 Label??
 

Attachments

  • Labels.PNG
    Labels.PNG
    47.8 KB · Views: 210
Gasman said:
Moke's code would not do that?
Have you even walked through the code?
Click to expand...
Hi Gasman
I put a breakpoint on the line:-

100 For i = 1 To Me.txtNumberOfLabels.Value

When I checked the value by hovering on the Me.txtNumberOfLabels.Value it indicates 10 labels which is the correct value.

Cannot see why the Report does not generate 10 Labels?
 
You must log in or register to reply here.

Similar threads

A
FILTER PRINT REPORT
Replies
2
Views
448
arnelgp
arnelgp
mike60smart
Syntax
Replies
7
Views
870
Mark_
M
A
Filter Records
Replies
1
Views
580
June7
June7
B
  • Question Question
Loop without Do stumped
Replies
6
Views
447
MajP
MajP
J
error in procedure
Replies
11
Views
1,360
arnelgp
arnelgp

Users who are viewing this thread

Total: 1 (members: 0, guests: 1)
Back
Top Bottom