#1
|
|||
|
|||
Numbering labels prints
Hello
I am trying to number the printing of labels. I cannot do it the "easy" way, by generating a file sent to the printer per label number, as our printer cannot cope with it (when it comes to > 100 labels it takes 30 min to print and all labels are out of order). So I thought I might just duplicate the label the required number of times, number the pages and print so it will be a single file. However, the way the code is set up today works for certain formats and not for others - while depending on the product the labels will have different formats and I need the operators here to be able to print quickly and easily via 1 button. I have added some examples of labels - one of which only is working. I do hope somebody will be able to help me (I have a very limited knowledge of word VBA!!!) Many thanks, Kind regards valeria My not fully working code is: Code:
Public EndPage Public IBCtoBeOrNotToBe ' Sub MacroLabels() Dim Message As String, Title As String, Default As String, NumCopies As Long Dim Rng1 As Range Dim objTemplate As Template Dim objBB As BuildingBlock Msg = "Est-ce que le packaging c'est des IBCs?" ' Define message. Style = vbYesNo + vbCritical + vbDefaultButton2 ' Define buttons. Title = "Type de Packaging" ' Define title. ' Display message. Response = MsgBox(Msg, Style, Title) If Response = vbYes Then IBCtoBeOrNotToBe = "Yes" Else ' User chose No. IBCtoBeOrNotToBe = "No" End If ' Set prompt. Message = "Rentrer le nombre d'etiquettes dont vous avez besoin" ' Set title. Title = "Print" ' Set default. Default = "1" ' Display message, title, and default value. NumCopies = Val(InputBox(Message, Title, Default)) SerialNumber = System.PrivateProfileString("C:\Settings.Txt", _ "MacroSettings", "SerialNumber") If NumCopies = 0 Then Exit Sub NumCopies = NumCopies + 1 If SerialNumber = "" Then SerialNumber = 1 End If Dim Rng As Range With ActiveDocument Set Rng = .GoTo(What:=wdGoToPage, Name:="1") Set Rng = Rng.GoTo(What:=wdGoToBookmark, Name:="\page") Rng.Copy counter = 1 While counter < NumCopies With .Range.Characters.Last .InsertBefore vbCr & Chr(12) .Collapse wdCollapseEnd .PasteAndFormat (wdFormatOriginalFormatting) End With SerialNumber = SerialNumber + 1 counter = counter + 1 Wend End With Call InsertTrianglePageNumber ActivePrinter = "active printer" EndPage = NumCopies - 1 End Sub ' Sub Print1() If IBCtoBeOrNotToBe = "No" Then ActiveDocument.PrintOut Range:=wdPrintRangeOfPages, Pages:="1-" & EndPage, Copies:=1 Else ActiveDocument.PrintOut Range:=wdPrintRangeOfPages, Pages:="1-" & EndPage, Copies:=2 End If End Sub ' Sub InsertTrianglePageNumber() Dim tmp As Template Dim shp As Shape Dim rg As Range With ActiveDocument Set rg = .Sections(1).Footers(wdHeaderFooterPrimary).Range If rg.ShapeRange.Count > 0 Then rg.ShapeRange.Delete Set tmp = GetBBTemplate If Not tmp Is Nothing Then tmp.BuildingBlockEntries("Triangle 1").Insert _ Where:=rg, RichText:=True Set shp = rg.ShapeRange(1) With shp .Fill.ForeColor.ObjectThemeColor = wdThemeColorBackground1 .Fill.ForeColor.TintAndShade = -0.15 .Fill.Solid .Fill.Visible = msoFalse With .TextFrame.TextRange.Font .Color = 0 'seems to give the same black as -587137025 .Name = "Calibri" .Size = 36 .Bold = True End With End With Else MsgBox "Could not find Building Blocks.dotx template", , "Error" End If End With End Sub ' Function GetBBTemplate() As Template Dim tmp As Template Templates.LoadBuildingBlocks For Each tmp In Templates If LCase(tmp.Name) = "building blocks.dotx" Then Set GetBBTemplate = tmp Exit For End If Next End Function ex1 label.docx ex working labels.docx ex 3 label.docx ex. label 4.docx ex label 5.docx Last edited by macropod; 11-29-2013 at 05:08 PM. Reason: Added code tags & formatting |
#2
|
||||
|
||||
Hi Valeria,
Try the attached copy of your 'ex1 label' document. What I've done is to move all your content into the page header. At the moment, it's just a proof-of-concept demo, based on the code from: https://www.msofficeforums.com/word-vba/12959-sequential-document-numbering.html#post34477 If the approach taken meets your needs, we can modify the code with your macro wording, etc, then add just the code to a template that you could attach to all your documents so that they wouldn't need to each have the same code and could be saved as .docx files. If you examine the code, you'll see there are some lines commented-out. For production use, those lines could be made active so that, amongst other things, the printout happens automatically - a different approach could be taken to work through the print dialogue if you prefer. The commented-out line to update the page # means that, next time the document is opened, the starting number would always be one more than the finishing number from the time before.
__________________
Cheers, Paul Edstein [Fmr MS MVP - Word] |
#3
|
|||
|
|||
Hello Paul! I have tried it and it works if you move the content of the document as you explain... The issue I have is that our labels are generated by an external program every time (as legislation/hazards etc might change) so I do not have a library of word documents that I could modifiy, instead I need to work with a freshly generated document every time...
Is there possibily another way to get at it? Thanks again!!!! Valeria |
#4
|
||||
|
||||
OK, what I'd suggest is creating a plain template with the following macro in it:
Code:
Sub PrintMe() Application.ScreenUpdating = False Dim iStart As Long, iEnd As Long, iCount As Long, StrPages As String On Error GoTo Done With ActiveDocument iStart = .Sections.First.Headers(wdHeaderFooterPrimary).PageNumbers.StartingNumber If iStart = 0 Then iStart = 1 iStart = InputBox("What is the First Number?", "Numbering Start From", iStart) iEnd = InputBox("What is the Last Number?", "Numbering Stop At", iStart) If IsNumeric(iStart) = False Or IsNumeric(iEnd) = False Then GoTo Done If iStart > iEnd Or iEnd = 0 Then GoTo Done iCount = iEnd - iStart If Len(.Range.Text) > 1 Then With .Styles("Page Number").Font .Size = 16 .Name = "Arial" .Bold = True End With .Range.Cut With .Sections.First.Headers(wdHeaderFooterPrimary) .Range.Paste With .PageNumbers .Add PageNumberAlignment:=wdAlignPageNumberRight, FirstPage:=True .RestartNumberingAtSection = True .StartingNumber = iStart End With End With End If For iCount = iStart To iEnd - 1 StrPages = StrPages & Chr(12) Next iCount .Range.InsertAfter StrPages With Application.Dialogs(wdDialogFilePrint) If .Show <> True Then iEnd = iStart - 1 End With .Range.Delete .Sections.First.Headers(wdHeaderFooterPrimary).PageNumbers.StartingNumber = iEnd + 1 End With Done: Application.ScreenUpdating = True End Sub Then, whenever you get one of these labels generated by the external program, simply go to Developer|Document template and attach your template. If you then run the 'PrintMe' macro, that will take care of moving the content into the header and generating the pages. As written, the code allows you to re-use the document later on, though you will need to re-save it after attaching the template (which you only need do once) to keep the template attached.
__________________
Cheers, Paul Edstein [Fmr MS MVP - Word] |
#5
|
|||
|
|||
hello Paul, thanks! I will test this first thing tomorrow morning and let you know. Thanks, kind regards Valeria
|
#6
|
|||
|
|||
Hello Paul, again, sorry for this very late reply. I was able to test the macro today only in the end; it works very well for most labels except for a couple where it deletes almost everything, like the one I have attached (all the ones not working that I have found are the ones with the big symbol on the right if it can help). I am not good enough to understand why....
A second question is how to change the position of the numbering to the bottom left-hand side... Again many thanks! Best regards Valeria |
#7
|
||||
|
||||
Hi Valeria,
Try this version of the code: Code:
Sub PrintMe() Application.ScreenUpdating = False Dim iStart As Long, iEnd As Long, iCount As Long, StrPages As String Dim Shp As Shape, i As Long On Error GoTo Done With ActiveDocument iStart = .Sections.First.Headers(wdHeaderFooterPrimary).PageNumbers.StartingNumber If iStart = 0 Then iStart = 1 iStart = InputBox("What is the First Number?", "Numbering Start From", iStart) iEnd = InputBox("What is the Last Number?", "Numbering Stop At", iStart) If IsNumeric(iStart) = False Or IsNumeric(iEnd) = False Then GoTo Done If iStart > iEnd Or iEnd = 0 Then GoTo Done iCount = iEnd - iStart For i = 1 To .Paragraphs.Count With .Paragraphs(i).Range If .Frames.Count = 0 Then If .Information(wdWithInTable) = False Then .ParagraphFormat.LeftIndent = .Characters.First.Information(wdHorizontalPositionRelativeToTextBoundary) _ + .PageSetup.LeftMargin - .PageSetup.RightMargin .ParagraphFormat.Alignment = wdAlignParagraphLeft End If End If End With Next With .PageSetup .HeaderDistance = 18 .FooterDistance = 18 .LeftMargin = .RightMargin End With For i = .InlineShapes.Count To 1 Step -1 Set Shp = .InlineShapes(i).ConvertToShape With Shp .RelativeHorizontalPosition = wdRelativeHorizontalPositionPage .RelativeVerticalPosition = wdRelativeVerticalPositionPage .WrapFormat.Type = wdWrapTight End With Next For Each Shp In .Shapes With Shp .Anchor.Move wdStory, 1 End With Next For i = .Tables.Count To 1 Step -1 With .Tables(i) If Len(Trim(Replace(.Range.Text, Chr(13) & Chr(7), ""))) = 0 Then .Delete End With Next For i = .Frames.Count To 1 Step -1 With .Frames(i) If .Range.Tables.Count = 0 Then .Delete End With Next If Len(.Range.Text) > 1 Then .Range.Cut With .Sections.First.Headers(wdHeaderFooterPrimary).Range .Paste For i = 1 To .Paragraphs.Count With .Paragraphs(i).Range If .Information(wdWithInTable) = False Then If Len(.Text) = 1 Then With .Font .Size = 1 End With Else Exit For End If End If End With Next End With With .Sections.First.Footers(wdHeaderFooterPrimary) With .PageNumbers .Add PageNumberAlignment:=wdAlignPageNumberLeft, FirstPage:=True .RestartNumberingAtSection = True .StartingNumber = iStart End With .Range.Fields(1).Code.InsertAfter " \# 0000" End With With .Styles("Page Number").Font .Size = 16 .Name = "Arial" .Bold = True End With End If For iCount = iStart To iEnd - 1 StrPages = StrPages & Chr(12) Next iCount .Range.InsertAfter StrPages With Application.Dialogs(wdDialogFilePrint) If .Show <> True Then iEnd = iStart - 1 End With .Range.Delete .Sections.First.Footers(wdHeaderFooterPrimary).PageNumbers.StartingNumber = iEnd + 1 End With Done: Application.ScreenUpdating = True End Sub
__________________
Cheers, Paul Edstein [Fmr MS MVP - Word] |
#8
|
|||
|
|||
Hello Paul, FANTASTIC!!!! It works very well!!!! THANK YOU!!!!
Where did you learn to programme Word VBA this well? Are there resources (books...) that I could use to try to learn myself a bit more? Again THANK YOU SO MUCH, this is really wonderful!!!! Kind regards Valeria |
#9
|
||||
|
||||
Quote:
A book you might find useful (I did much of the technical review) is The Secret Life of Word: A Professional Writer's Guide to Microsoft Word Automation, by R Delwood, and published by XML Press (http://xmlpress.net/publications/word-secrets/). This isn't a programming book as such (though it does have some programming in it) and doesn't profess to teach you how to program. Rather, it shows how to combine Word's various tools to achieve whatever the desired result might be. Another that I contributed to (and has much more programming in it) is Word Hacks, by A Savikas and published by O'Reily Media (http://shop.oreilly.com/product/9780596004934.do). Although that one pre-dates Office 2007, much of the content is still relevant.
__________________
Cheers, Paul Edstein [Fmr MS MVP - Word] |
|
Similar Threads | ||||
Thread | Thread Starter | Forum | Replies | Last Post |
Prints in half page landscape | lostsoul62 | Excel | 2 | 07-22-2013 01:24 PM |
Printing Issue - What is see in preview is not what actually prints - PLEASE HELP!!! | clariberry | Word | 2 | 05-03-2012 10:42 AM |
VBA Print Command Prints Document Twice | HorizonSC | Word | 2 | 11-15-2011 03:26 AM |
word only prints pictures | AidyTy | Word | 0 | 12-15-2009 01:50 PM |
Footer so low on page only top half prints | Renee Hendershott | Word | 1 | 01-22-2006 05:09 PM |