VBA to print labels from excel

Shadkng

Active Member
Joined
Oct 11, 2018
Messages
365
Hi, I am trying to print labels from an excel file to a Zebra thermal printer. I have the code working OK so far but I think it needs improvement. The idea is to print several ranges of text sequentially - the range of each section will not change. I included my test excel file with just 2 ranges and with a cell next to each range containing the number of copies. I may have as many as 20 or 30 ranges to print one after the other in one pass. So I was going to repeat the code that many times but I doubt that's the best way. Below is a link to the file on dropbox. Also see code below.

I was also having trouble naming the printer in the code. I was using the name of the printer in quotes as I saw online, but do I have to name the port? Thanks for the help.

https://www.dropbox.com/s/214yglxcqzid785/test label.xlsm?dl=0

Sub ZEBRA_LABEL3()
If Range("a5").Value > 0 Then
With ActiveSheet.PageSetup
.PrintArea = "$B$5:$E$8"
.FitToPagesWide = 1
.FitToPagesTall = False
Application.Dialogs(xlDialogPrinterSetup).Show
ActiveSheet.PrintOut Copies:=Range("A5").Value
End With
End If
If Range("a11").Value > 0 Then
With ActiveSheet.PageSetup
.PrintArea = "$B$11:$E$14"
.FitToPagesWide = 1
.FitToPagesTall = False
ActiveSheet.PrintOut Copies:=Range("A11").Value
End With
End If
End Sub
 
Last edited:
And you still haven't done as I have said you need to do a number of times now. See, in particular, post #31 .
 
Upvote 0

Excel Facts

Ambidextrous Undo
Undo last command with Ctrl+Z or Alt+Backspace. If you use the Undo icon in the QAT, open the drop-down arrow to undo up to 100 steps.
In posy #31 you said to change to
Range("D" & r).Value = c & " of " & p

Which I did in the latest code I posted. I added the +8 so it would print in an empty cell to test.
Range("d" & r + 8).Value = c & " of " & p
 
Upvote 0
What I said in post #1 was:
Clearly, though, you want the output in column C on rows 12, 22, etc. Accordingly, you need to change:
Range("D" & r).Value = c & " of " & p
to suit.
Changing D to d isn't going to make the code reference column C...
 
Upvote 0
Hi, so now it prints "1 of" for the first label because it's counting the quantity only for that label. But I should explain better what it needs to do...I don't know if you were able to take a look at the file. Each label has it's own quantity to print starting in cell B10, then the next label in B20, B30 and so on for 17 labels. Cell B1 has the total number of labels needed so the "1 of" needs to count up to that quantity, not to the quantity for next to each label. If the quantity per label is zero (B10, B20,etc) then that label should be skipped. I changed the code to print the "1 of" in cell D18. Below is the latest code. I can't do anymore on my own as I don't fully understand the code.

Code:
Sub ZEBRA_LABEL_FINAL_ONE_OF()
Dim r As Long, c As Long, p As Long, StrPrn As String
StrPrn = Application.ActivePrinter
With ActiveSheet
  With .PageSetup
    .Zoom = False
    .FitToPagesWide = 1
    .FitToPagesTall = 1
    .LeftMargin = 0
    .TopMargin = 5
    .RightMargin = 0
    .BottomMargin = 5
  End With
  If Not (Application.Dialogs(xlDialogPrinterSetup).Show) Then Exit Sub
  
  For r = 10 To .Cells.SpecialCells(xlCellTypeLastCell).Row Step 10
    .PageSetup.PrintArea = "$C$" & r & ":$E$" & r + 8
     p = Range("B1" & r).Value
    
    For c = 1 To p
      Range("D" & r + 8).Value = c & " of " & p  '(cell D18 is where the "1 of" should print)
      ActiveSheet.PrintOut
    Next
    Range("D" & r + 8).Value = ""
  Next
End With
End Sub
 
Upvote 0
Try:
Code:
Sub ZEBRA_LABEL_FINAL()
Dim c As Long, i As Long, j As Long, p As Long, r As Long, StrPrn As String
StrPrn = Application.ActivePrinter
With ActiveSheet
  With .PageSetup
    .Zoom = False
    .FitToPagesWide = 1
    .FitToPagesTall = 1
    .LeftMargin = 0
    .TopMargin = 5
    .RightMargin = 0
    .BottomMargin = 5
  End With
  If Not (Application.Dialogs(xlDialogPrinterSetup).Show) Then Exit Sub
  p = Range("B1").Value
  For r = 4 To .Cells.SpecialCells(xlCellTypeLastCell).Row Step 10
    .PageSetup.PrintArea = "$C$" & r & ":$F$" & r + 8
    j = Range("B" & r).Value
    For i = 1 To j
      c = c + 1
      Range("C" & r + 8).Value = "BOX " & c & " of " & p
      ActiveSheet.PrintOut
    Next
    Range("C" & r + 8).Value = "BOX # of #"
  Next
End With
End Sub
 
Upvote 0
Hi Paul,

Works perfectly!! you made my day...thanks for sticking with me and all my questions.
 
Upvote 0

Forum statistics

Threads
1,214,632
Messages
6,120,655
Members
448,975
Latest member
sweeberry

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top