Solved Printing Labels

mike60smart

mike60smart

Registered User.
Local time
Today, 21:37
Joined
Aug 6, 2017
Messages
1,995
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: 149
So you do not have the ado reference set?
 

Attachments

  • error.PNG
    error.PNG
    5.1 KB · Views: 132
  • error2.PNG
    error2.PNG
    6 KB · Views: 138
  • Line330.PNG
    Line330.PNG
    8.4 KB · Views: 133
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:
If you create a table with a list of numbers from 1 to whatever, you can use a non-equi-join to that table to "duplicate" the records.

FROM Transactions Inner Join tblRepeat On Transactions.LabelCount >= tblRepeat.Count

No hard coding required. This will print a distinct number of labels for each row in Transactions. So, if you only need one label, LabelCount in Transactions will be 1. But if you need 10 labels, the value will be 10.

You can't create a non-equi-join in QBE view so create the equi-join and then switch to SQL view. Once you add the">" to the "=", you won't be able to go back to QBE view.
 
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: 121
You must log in or register to reply here.

Similar threads

J
error in procedure
Replies
12
Views
617
Pat Hartman
P
A
Access Audittrail
Replies
5
Views
253
CJ_London
C
Papashep
Solved Access vba Manage an Attachment field with vba
Replies
8
Views
1,050
Pat Hartman
P
mike60smart
Error 2501
2
Replies
29
Views
1,407
mike60smart
mike60smart
mike60smart
PDF Attachments
Replies
5
Views
896
mike60smart
mike60smart

Users who are viewing this thread

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