Setting Print Quantity - Any Ideas?

Sub B_PMWR()
    Dim groups As ShapeRange
    Dim group As Shape
    Dim groupname As String, path As String
    Set groups = ActiveSelectionRange
    Dim i As Long
    Dim pctdone As Single
    Dim doc As Document
    Set doc = ActiveDocument
    
    ActiveDocument.BeginCommandGroup "Quantity"
    
    Quantity.Show
    
    ActiveDocument.EndCommandGroup
    
'Display Progress Bar
    ufProgress.LabelProgress.Width = 0
    ufProgress.Show

    For i = 1 To groups.Count
    
'Update progress bar
    pctdone = i / groups.Count
    With ufProgress
        .LabelCaption.Caption = "Printing " & i & " of " & groups.Count
        .LabelProgress.Width = pctdone * (.FrameProgress.Width)
    End With
    DoEvents
    
'-------the rest of your macro goes below here-------

    groupname = groups.Shapes(i).Name
    groups.Shapes(i).CreateSelection
    
    'FIT TO PAGE:
    GMSManager.RunMacro "JQ_Fit_Page_To_Content", "JQ.Fit_Page_To_Content_No_Form"
    
    Select Case ActivePage.SizeHeight Or ActivePage.SizeWidth
        Case Is <= 36
            With doc.PrintSettings
                    .PrintRange = prnSelection
                    .SelectPrinter "B PMWR"
                    .PageMatchingMode = prnPageMatchSizeAndOrientation
                    .Copies = ActiveShape.Name
                    .PrintOut
            End With
            
        Case Is > 60
            With doc.PrintSettings
                    .SelectPrinter "C PMWR 60"
                    .UsePPD = True
                    .PPDFile = "C:\Program Files\Fiery\Fiery XF Universal Driver\Release\WinDll\i386x64\EFIUnidrv.PPD"
                    .PageMatchingMode = prnPageMatchSizeAndOrientation
                    .Copies = ActiveShape.Name
                    .PrintOut
            End With
            
        Case Is > 129
            With doc.PrintSettings
                    .SelectPrinter "B PMWR"
                    .UsePPD = True
                    .PPDFile = "C:\Program Files\Fiery\Fiery XF Universal Driver\Release\WinDll\i386x64\EFIUnidrv.PPD"
                    .PageMatchingMode = prnPageMatchSizeAndOrientation
                    .Copies = ActiveShape.Name
                    .PrintOut
            End With
        
    End Select
    
'----------------------------------------------------
'Close Progress Bar
    Next i
    Unload ufProgress

'Zoom Out To All Objects
    ActiveWindow.ActiveView.ToFitAllObjects
    
'Undo
    For Each group In groups
    ActiveDocument.Undo
    Next group
    
    ActiveDocument.Undo
    
End Sub

Option Explicit

#If VBA7 Then
    Private Declare PtrSafe Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
    Private Declare PtrSafe Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long
    Private Declare PtrSafe Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
    Private Declare PtrSafe Function DrawMenuBar Lib "user32" (ByVal hwnd As Long) As Long
    Private Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal milliseconds As LongPtr)
#Else
    Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
    Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long
    Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
    Private Declare Function DrawMenuBar Lib "user32" (ByVal hwnd As Long) As Long
    'Private Declare Sub Sleep Lib "kernel32" (ByVal milliseconds as Long)
#End If

Private Const GWL_STYLE As Long = (-16)
Dim lngx As Integer, lngy As Integer

Private Sub Cancel_Click()
    End
End Sub

Private Sub Qty_Change()
    If Qty.Value <= 0 Then 'No negative value
       Qty.Value = 1
    End If
End Sub

Public Sub QtyPrint_Click()
    
    Dim s As Shape, n$
    
    Select Case QtyAll.Value
        Case True
            For Each s In ActiveSelection.Shapes
                s.Name = Qty.Value
            Next s
            Unload Quantity
        
        Case False
                For Each s In ActiveSelection.Shapes
                    ActiveWindow.ActiveView.ToFitSelection
                    s.Outline.SetProperties 5 / 72
                    s.Outline.Color.RGBAssign 255, 0, 0
                    n = InputBox("Quantity")
                    s.Name = n
                    s.Outline.SetNoOutline
            Next s
            Unload Quantity
    End Select
    
End Sub

Private Sub SpinButton1_SpinUp()
    Qty.Value = Qty.Value + 1
End Sub

Private Sub SpinButton1_SpinDown()
    Qty.Value = Qty.Value - 1
End Sub

Private Sub QtyAll_Change()
    Select Case QtyAll.Value
        Case True
            Qty.Enabled = True
        Case False
            Qty.Enabled = False
            SpinButton1.Enabled = False
            QtyPrint.SetFocus
    End Select
End Sub

Private Sub UserForm_Initialize()

    Dim frm As Long, wHandle As Long
    wHandle = FindWindow(vbNullString, Me.Caption)
    frm = GetWindowLong(wHandle, GWL_STYLE)
    SetWindowLong wHandle, -16, 0
    DrawMenuBar wHandle
    Me.Width = 90
    Me.Height = 137
    

    Dim ctrl As MSForms.Control, BC As Long, FC As Long
    BC = RGB(56, 56, 56)
    FC = RGB(255, 255, 255)
    
    For Each ctrl In Quantity.Controls
        ctrl.BackColor = BC
        ctrl.ForeColor = FC
    Next
    
    Quantity.BackColor = RGB(56, 56, 56)
    
    
    QtyAll.Value = True 'Check/Uncheck
    
    Qty.Value = 1
    Qty.TabStop = False
    
End Sub