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

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

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