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