Easy way to print adress labels

Hi!

The sub below is for printing adress labels from the database.
I made this one just to make my life a bit easier, when I was trying to do the same
with Word through VB (never got it to work).
It uses pre-formated margin numbers (dWidth, dHeight, iCol, iRow) for I've used
ZweckForm's 64.6 X 33.8 mm labels (3 X 8 on one sheet). Alter that as you wish (don'r forget
to change the left and upper margin aswell!)
It's quite easy to use. Just pass the SQL string and the destination object to it.
I've used object just to provide a simple preview (I normaly use picture box for that).

Hopefully, someone will find use of it (I know I did). If you have any questions or problem,
contact me here.

If you don't know how to make preview, search for my PRINTPREVIEW post (it should be somewhere on the other page of this forum).

Have fun!

Ales



Public Sub PrintLabels(SQL As String, Console As Object)
'NOTE! ALL MEASUREMENTS ARE IN MILLIMETERS (ScaleMode=6)
'it uses DAO for connection! MAke appropriate changes to sute your needs****
'labels used in these calculations are standard ZweckForm 64.4mm X 33.8mm!
'the sheet contains 3 X 8 labels!
Console.ScaleMode = 6
Dim dWidth As Double 'the width of the label
Dim dHeight As Double 'the height of the label
Dim iCol As Integer 'number of labels in a row
Dim iRow As Integer 'number of labels in a column
Dim iLine As Integer 'Number of labels in a row
Dim iLeft As Long 'left margin of the label printout
Dim iDown As Integer 'Number of labels in a column
Dim dY As Double 'lower margin of the label box

iLeft = 16 '16mm from the left
iLine = 1
iDown = 1
'set up the labels on the sheet
'alter this to sute your needs
dWidth = 64.6
dHeight = 33.8
iCol = 3
iRow = 8

Console.CurrentY = 25 '25mm from the top
Set rstTest = conTest.OpenRecordset(SQL & " ORDER BY LastName", dbOpenDynaset)
If Not rstTest.EOF And Not rstTest.BOF Then
With rstTest
.MoveFirst
Do Until .EOF
'print the first label
Console.CurrentX = iLeft
Console.Print !Name & " " & !LastName
Console.CurrentX = iLeft
Console.Print !Street
Console.CurrentX = iLeft
Console.Print !Post & " " & !City
'you can comment out this IF statement if you want the box to be printed
'on the paper aswell!
If TypeOf Console Is PictureBox Then 'draw the box around the label
'remember CurrentY
dY = Console.CurrentY
Console.Line (iLeft - iRow, Console.CurrentY - Console.TextHeight("A") * iCol - 11) _
-(iLeft - iRow + dWidth, Console.CurrentY - Console.TextHeight("A") * iCol - 11 + dHeight), vbGreen, B
'set it back
Console.CurrentY = dY
End If
iLeft = iLeft + dWidth 'add 64.6mm to print another label in a row
Console.CurrentY = Console.CurrentY - Console.TextHeight("A") * 3 'pull back 3 rows
.MoveNext
iLine = iLine + 1
If iLine > iCol Then 'if three labels were printed goto next row
iLine = 1
iLeft = 16 'pull back to the left margin (16mm)
iDown = iDown + 1
If iDown > iRow Then
'if eight rows were printed check for the destination object
If TypeOf Console Is Printer Then
'tell the printer to load NEW Page
Console.NewPage
Else
'load new picture box
'replace frmTestPrint and Picture1 with your own names!!!
Load frmTestPrint.Picture1(frmTestPrint.Picture1.Count)
Set Console = frmTestPrint.Picture1(frmTestPrint.Picture1.UBound)
Console.CurrentY = 25
End If
iDown = 1
Else 'or print next row of labels
'print new line of labels
Console.CurrentY = Console.CurrentY + dHeight
End If
End If
Loop
If TypeOf Console Is Printer Then 'send document to the printer spooler
Console.EndDoc
End If
End With
Else
'if no data is found notify the user
MsgBox "No data to print!", , "Error In PRINTING LABELS"
End If
rstTest.Close
Set rstTest = Nothing
End Sub