Sub PrintNumberedCopiesEntireDocument()
'
' PrintNumberedCopiesEntireDocument Macro
' Shortcut keys Alt+E
'
Dim Msg As String, Ans As Variant
    Dim lCopiesToPrint As Long
    Dim lCounter As Long
    Dim lCopyNumFrom As Long
    
   Ans = MsgBox(Space(1) & "Is the document print settings configured for 'Print on Both Sides?" & vbCrLf & vbCrLf & _
        "If not then click 'No', click the 'File' tab, 'Print', select 'Print on Both Sides / Flip pages on long edge' and then press 'Alt+S'.", _
        vbMsgBoxSetForeground + vbQuestion + vbYesNoCancel, (Space(50) & "ABCDF 1234"))
   
       Select Case Ans
             
        Case vbYes
        Case vbNo
        End
        Case vbCancel
        End
        
End Select

    ' ask how many to print
    On Error GoTo Canceled
    lCopiesToPrint = InputBox( _
        Prompt:="How many copies do you require?", _
        Title:=(Space(45) & "ABCDF 1234"), _
        Default:="1")
     
    ' ask where to start numbering
    On Error GoTo Canceled
        lCopyNumFrom = InputBox( _
        Prompt:="Number at which to start numbering copies?", _
        Title:=(Space(45) & "ABCDF 1234"), _
        Default:=CStr(ActiveDocument.Variables("CopyNum") + 1))
        
    ' loop through the print-write-print cycle
    For lCounter = 0 To lCopiesToPrint - 1
        ' update the document variable
        ActiveDocument.Variables("CopyNum") = _
            lCopyNumFrom + lCounter
                With Options
                    .UpdateFieldsAtPrint = False
                    .UpdateLinksAtPrint = True
                End With
                    ActiveDocument.Fields.Update
        ' print this numbered copy
        ActiveDocument.PrintOut Copies:=1
    Next lCounter
    
Canceled:

End Sub

Option Explicit

Private self_result                                          As Boolean

Private Sub UserForm_Initialize()

    Me.StartUpPosition = 0
    Me.Top = Application.Top + (0.5 * Application.Height) - (Me.Height / 2)
    Me.Left = Application.Left + (0.5 * Application.width) - (Me.width / 2)
    
End Sub

Private Sub cmdCancel_Click()

    self_result = False
    Me.Hide
    
End Sub

Private Sub cmdOK_Click()

    If form_validates_ok Then
       self_result = True
       Me.Hide
       Exit Sub
    End If
End Sub


Public Property Get Result() As Boolean

    Result = self_result
    
End Property

Private Function form_validates_ok() As Boolean

    If Not IsNumeric(Trim(Me.txtCopies)) Then
        MsgBox "The number of copies should be a number", vbOKOnly
        Me.txtCopies.SetFocus
        Me.txtCopies.SelLength = Len(Me.txtCopies)
        form_validates_ok = False
        Exit Function
    End If
    
    If Not IsNumeric(Trim(Me.txtStartNumber)) Then
        MsgBox "The start number should be a number", vbOKOnly
        Me.txtStartNumber.SetFocus
        Me.txtStartNumber.SelLength = Len(Me.txtStartNumber)
        form_validates_ok = False
        Exit Function
    End If
    
    form_validates_ok = True
    
End Function

Sub PrintNumberedCopiesEntireDocument()
'
' PrintNumberedCopiesEntireDocument Macro
' Shortcut keys Alt+E
'

Const cdp_name                          As String = "CopyNum"
Const default_copies                    As String = "1"
Const duplex_printer                    As String = "Dell Printer 5100cn PS Duplex"  ' change this to the name of your duplex printer

Dim my_form                             As ufrmPrintNumberedCopies
Dim copy_number                         As Long
Dim first_copy                          As Long
Dim last_copy                           As Long
Dim my_update_fields_at_print           As Boolean
Dim my_update_link_at_print             As Boolean
Dim current_printer                     As String


    ' We are using a custom Document Property to save the serial number
    ' as we can edit this from the backstage properties advanced dialog
    ' if needed
    
    ensure_cdp_exists cdp_name
    
    Set my_form = New ufrmPrintNumberedCopies
    
    With my_form
        .txtStartNumber = Trim(ActiveDocument.CustomDocumentProperties(cdp_name))
        .txtCopies = default_copies
        .Show
            
        If Not .Result Then
            Exit Sub
        End If
    End With
    
    ' We now switch to the document printer that has been customised to aleays
    ' print in duplex
    
    current_printer = ActivePrinter
    ActivePrinter = duplex_printer
    
    ' The update fields and links at print time are application properties so anly need setting once
    ' but we preserve the values so we can restore the current settings after we have finished printing
    
    With Options
    
        my_update_fields_at_print = .UpdateFieldsAtPrint
        .UpdateFieldsAtPrint = True
        
        my_update_link_at_print = .UpdateLinksAtPrint
        .UpdateLinksAtPrint = True
        
    End With

    
    first_copy = CLng(Trim(my_form.txtStartNumber))
    last_copy = first_copy + CLng(Trim(my_form.txtCopies)) - 1
   
   
    MsgBox "Now we do the printing", vbOKOnly   'comment this out once tested
    
    ' it is assumed that there is a field somewhere that references the customdocumentproperty
    
'    For copy_number = first_copy To last_copy  ' uncomment the for loop once tested
'        ActiveDocument.CustomDocumentProperties(cdp_name) = Cstr(copy_number)
'        ActiveDocument.PrintOut copies:=1
'    Next
    
    
    ' save the next starting serial number
    ActiveDocument.CustomDocumentProperties(cdp_name) = last_copy + 1
    
    
    ' restore saved settings
    With Options
        .UpdateFieldsAtPrint = my_update_fields_at_print
        .UpdateLinksAtPrint = my_update_link_at_print
    End With

    ActivePrinter = current_printer

End Sub

Sub ensure_cdp_exists(cdp_name As String)
'cdp is short for CustomDocumentProperty

    ' Searches for the a custom document property of cdp_name
    ' If not found the custom document property is created and assigned a value of 1

Const default_start_number         As String = "1"

Dim my_cdp                          As DocumentProperty

    For Each my_cdp In ActiveDocument.CustomDocumentProperties
    
        If my_cdp.name = cdp_name Then
            Exit Sub
        End If
   
    Next
    
    ' We only get to this point if we don't find the target custom document property
    ' using the previous loop
    
    ActiveDocument.CustomDocumentProperties.Add _
        name:=cdp_name, _
        LinkToContent:=False, _
        Value:=default_start_number, _
        Type:=msoPropertyTypeString
    
    ' Be gentle with the user and let them know what has happened.
    MsgBox _
        Title:="Missing CustomDocumentProperty", _
        prompt:="CustomDocumentProperty '" & cdp_name & "' was added to the document" & vbCrLf & vbCrLf & "A value of '" & default_start_number & "' was assigned'", _
        Buttons:=vbOKOnly
    
End Sub

Option Explicit
Dim m_bTest As Boolean
Private Sub txtStartNumber_Change()
  Validate_OK
End Sub
Private Sub txtStartNumber_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
  m_bTest = IsInteger(KeyAscii)
  If m_bTest = False Then
    Beep
    KeyAscii = 0
  End If
End Sub
Private Sub txtCopies_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
  m_bTest = IsInteger(KeyAscii)
  If m_bTest = False Then
    Beep
    KeyAscii = 0
  End If
End Sub
Private Sub txtCopies_Change()
  Validate_OK
End Sub
Function IsInteger(ByVal i As String) As Boolean
  Select Case i  'Checking to see if inside valid Ascii range for integers
    Case 48 To 57: IsInteger = True
    Case Else: IsInteger = False
  End Select
End Function
Private Sub UserForm_Activate()
  Validate_OK
End Sub
Private Sub cmdCancel_Click()
  Tag = "CANCX"
  Hide
End Sub
Private Sub cmdOK_Click()
  Hide
End Sub
Private Sub Validate_OK()
  cmdOK.Enabled = True
  If Not IsNumeric(Trim(txtCopies)) Then cmdOK.Enabled = False
  If Not IsNumeric(Trim(txtStartNumber)) Then cmdOK.Enabled = False
End Sub

Option Explicit
Sub PrintNumberedCopiesSelect()
Const strCDP_name As String = "CopyNum"
Const strDuplex_printer As String = "hp deskjet 5550 series (HPA) duplex"  ' change this to the name of your duplex printer
Dim oFrm As frmPrintDialog
Dim lngCopy_number As Long, lngFirst_copy As Long, lngLast_copy As Long
Dim bUpdate_fields_at_print As Boolean, bUpdate_link_at_print As Boolean
Dim strCurrent_printer As String
  'We are using a custom Document Property to save the serial number as we can edit this from the backstage _
  properties advanced dialog.
  Validate_CDP strCDP_name
  Set oFrm = New frmPrintDialog
  With oFrm
    .txtStartNumber = Trim(ActiveDocument.CustomDocumentProperties(strCDP_name))
    .txtCopies = "1"
    .Show
    If .Tag = "CANCX" Then GoTo lbl_Exit
  End With
  'We now switch to the document printer that has been customised to aleays print in duplex.
  strCurrent_printer = ActivePrinter
  ActivePrinter = strDuplex_printer
  'The update fields and links at print time are application properties so anly need setting once _
  but we preserve the values so we can restore the current settings after we have finished printing
  With Options
    bUpdate_fields_at_print = .UpdateFieldsAtPrint
    .UpdateFieldsAtPrint = True
    bUpdate_link_at_print = .UpdateLinksAtPrint
    .UpdateLinksAtPrint = True
  End With
  lngFirst_copy = CLng(Trim(oFrm.txtStartNumber))
  lngLast_copy = lngFirst_copy + CLng(Trim(oFrm.txtCopies)) - 1
  'MsgBox "Now we do the printing", vbOKOnly   'comment this out once tested
  'It is assumed that there is a field somewhere that references the customdocumentproperty
  For lngCopy_number = lngFirst_copy To lngLast_copy ' uncomment the for loop once tested
    ActiveDocument.Variables(strCDP_name) = CStr(lngCopy_number)
    ActiveDocument.PrintOut copies:=1, Pages:=oFrm.txtPages.Value
  Next
  'Save the next starting serial number
  ActiveDocument.CustomDocumentProperties(strCDP_name) = lngLast_copy + 1
  'Restore saved settings
  With Options
    .UpdateFieldsAtPrint = bUpdate_fields_at_print
    .UpdateLinksAtPrint = bUpdate_link_at_print
  End With
  ActivePrinter = strCurrent_printer
lbl_Exit:
  Unload oFrm
  Set oFrm = Nothing
End Sub
Sub Validate_CDP(strCDP_name As String)
Dim oCDP As DocumentProperty
  'See if custom document property already exists.
  On Error Resume Next
  Set oCDP = ActiveDocument.CustomDocumentProperties(strCDP_name)
  If Not oCDP Is Nothing Then Exit Sub
  On Error GoTo 0
  'It doesn't exists so create it.
  ActiveDocument.CustomDocumentProperties.Add Name:=strCDP_name, _
                LinkToContent:=False, Value:="1", Type:=msoPropertyTypeString
  MsgBox "A CustomDocumentProperty named """ & strCDP_name & """ with the value ""1"" was added to the document.", _
         vbInformation + vbOKOnly, "Create CustomDocumentProperty"
lbl_Exit:
  Exit Sub
End Sub