Attribute VB_Name = "TrayPrint"
Public oEvt             As WrdTrigg
Global cPopCtrl         As CommandBarControl
Global cPopBar          As CommandBar
Global ptSelectAndPrint As Boolean
Public LastPrinter      As String
Private aTemplate       As Template
Private Const DC_TEMPLATENAME = "Firm.dot"
Private Const DC_BINS = 6
Private Const DC_BINNAMES = 12
Dim vBinNumbers         As Variant
Dim xx                  As Variant
Dim vCount              As Integer
Private Declare Function DeviceCapabilities Lib "winspool.drv" _
    Alias "DeviceCapabilitiesA" (ByVal lpDeviceName As String, _
    ByVal lpPort As String, ByVal iIndex As Long, lpOutput As Any, _
    ByVal dev As Long) As Long
'
'   See the AutoExec Subroutine in Main for Instantiation
'
'Sub Autoexec()
'
'    '
'    '   Section For TrayPrint Object Instantiation
'    '   and initialization.
'    '
'    Set oEvt = New WrdTrigg
'    Set oEvt.WrdTrig = Word.Application
'    TrayPrint.SetTrays
'
'End Sub

Sub SetTrays()
    On Error Resume Next
    Dim lBar As CommandBar
    Dim cBttn As CommandBarButton
    Dim BarCount As Long
    For Each lBar In Word.CommandBars
        If lBar.Name = "TrayPrint" Then
            BarCount = BarCount + 1
        End If
    Next
    If BarCount < 2 Then
        For Each lBar In Word.CommandBars
            If lBar.Name = "TrayPrint" Then
                lBar.Visible = True
                If Err.Number <> 0 Then
                    Err.Clear
                    Exit For
                End If
                GoTo BarSet
            End If
        Next
    Else
        For Each lBar In Word.CommandBars
            If lBar.Name = "TrayPrint" Then
                lBar.Delete
            End If
        Next
    End If
    Set lBar = Word.CommandBars.Add(Name:="TrayPrint", Position:=msoBarTop, MenuBar:=False, Temporary:=False)
    lBar.Visible = True
BarSet:
    Word.NormalTemplate.CustomDocumentProperties.Add Name:="Wtx_TrayPrintMode", LinkToContent:=False, _
            Value:="", Type:=4
    If Word.NormalTemplate.CustomDocumentProperties("Wtx_TrayPrintMode").Value = "1" Then
        ptSelectAndPrint = False
    Else
        ptSelectAndPrint = True
    End If
    For Each cPopCtrl In lBar.Controls
        If cPopCtrl.Tag = "TrayPrint" Then
            cPopCtrl.Delete
            Exit For
        End If
    Next
    Set cPopCtrl = lBar.Controls.Add(msoControlPopup)
PopSet:
    With cPopCtrl
        .Enabled = True
        .Visible = True
        .Tag = "TrayPrint"
        .Caption = "Print To Tray"
        .Width = 60
        .BeginGroup = True
        .TooltipText = " Select Printer Tray and Print Document "
    End With
    Set cPopBar = cPopCtrl.CommandBar
    cPopBar.Name = "PrintTray Popup"
    
    vCount = 0
    For Each xx In GetBinNames()
        Set cBttn = BttnAdd(cPopBar, 0, CStr(xx), "pt" & vCount, True, True, False, 0, msoButtonIconAndCaption, , 20)
        vCount = vCount + 1
    Next
    If ptSelectAndPrint = True Then
        Set cBttn = BttnAdd(cPopBar, 1087, "Select and Print", "ptSelectPrint", True, True, True, 0, msoButtonIconAndCaption, , 25)
        Set cBttn = BttnAdd(cPopBar, 0, "Select Tray Only", "ptSelectOnly", True, True, False, 0, msoButtonIconAndCaption, , 25)
    Else
        Set cBttn = BttnAdd(cPopBar, 0, "Select and Print", "ptSelectPrint", True, True, True, 0, msoButtonIconAndCaption, , 25)
        Set cBttn = BttnAdd(cPopBar, 1087, "Select Tray Only", "ptSelectOnly", True, True, False, 0, msoButtonIconAndCaption, , 25)
    End If
    
    vBinNumbers = GetBinNumbers
    
    For Each aTemplate In Word.Templates
        If UCase(aTemplate.Name) = UCase(DC_TEMPLATENAME) Then
            aTemplate.Saved = True
            Exit For
        End If
    Next

End Sub
Sub ptSelectPrint()
    On Error Resume Next
    Set cBttn = BttnAdd(cPopBar, 1087, "Select and Print", "ptSelectPrint", True, True, True, 0, msoButtonIconAndCaption, , 25)
    Set cBttn = BttnAdd(cPopBar, 0, "Select Tray Only", "ptSelectOnly", True, True, False, 0, msoButtonIconAndCaption, , 25)
    ptSelectAndPrint = True
    Word.NormalTemplate.CustomDocumentProperties.Add Name:="Wtx_TrayPrintMode", LinkToContent:=False, _
            Value:="", Type:=4
    Word.NormalTemplate.CustomDocumentProperties("Wtx_TrayPrintMode").Value = "0"

'    For Each aTemplate In Word.Templates
'        If UCase(aTemplate.Name) = UCase(DC_TEMPLATENAME) Then
'            aTemplate.Save
'            aTemplate.Saved = True
'            Exit For
'        End If
'    Next
    cPopCtrl.Execute
End Sub
Sub ptSelectOnly()
    On Error Resume Next
    Set cBttn = BttnAdd(cPopBar, 0, "Select and Print", "ptSelectPrint", True, True, True, 0, msoButtonIconAndCaption, , 25)
    Set cBttn = BttnAdd(cPopBar, 1087, "Select Tray Only", "ptSelectOnly", True, True, False, 0, msoButtonIconAndCaption, , 25)
    ptSelectAndPrint = False
    Word.NormalTemplate.CustomDocumentProperties.Add Name:="Wtx_TrayPrintMode", LinkToContent:=False, _
            Value:="", Type:=4
    Word.NormalTemplate.CustomDocumentProperties("Wtx_TrayPrintMode").Value = "1"
    cPopCtrl.Execute
End Sub
Function BttnAdd(cBar As CommandBar, FaceID As Integer, CaptionString As String, _
        BttnTag As String, BttnEnabled As Boolean, BttnVisible As Boolean, _
        BttnStartGroup As Boolean, BttnWidth As Long, BttnStyle As Integer, Optional TipText As String = "", Optional BttnHeight As Integer) As CommandBarButton
    On Error Resume Next
    If cBar Is Nothing Then
        Exit Function
    End If
    Set cBttn = cBar.FindControl(Tag:=BttnTag)
    If cBttn Is Nothing Then
        Set cBttn = cBar.Controls.Add(1)
    End If
    With cBttn
        If CaptionString = "" Then
            .Caption = idModule & "-" & FaceID
        Else
            .Caption = CaptionString
        End If
        .Tag = BttnTag
        .OnAction = BttnTag
        .Enabled = BttnEnabled
        .Visible = BttnVisible
        .BeginGroup = BttnStartGroup
        .Parameter = idModule & "-" & FaceID
        .FaceID = FaceID   'The image from Word's Numbered List Button
        .Height = 20
        
        If Len(TipText) > 0 Then
            .TooltipText = TipText
        End If
        If BttnWidth > 0 Then
            .Width = BttnWidth
        End If
        If BttnHeight > 0 Then
            .Height = BttnHeight
        End If
        .Style = BttnStyle
    End With
    Set BttnAdd = cBttn
    Exit Function
End Function
Public Function GetBinNumbers() As Variant
    On Error Resume Next

    'Code adapted from Microsoft KB article Q194789
    'HOWTO: Determine Available PaperBins with DeviceCapabilities API
    Dim iBins As Long
    Dim iBinArray() As Integer
    Dim sPort As String
    Dim sCurrentPrinter As String

    'Get the printer & port name of the current printer
    sPort = Trim$(Mid$(Word.ActivePrinter, InStrRev(Word.ActivePrinter, " ") + 1))
    sCurrentPrinter = Trim$(Left$(Word.ActivePrinter, _
        InStr(Word.ActivePrinter, " on ")))

    'Find out how many printer bins there are
    iBins = DeviceCapabilities(sCurrentPrinter, sPort, _
        DC_BINS, ByVal vbNullString, 0)

    'Set the array of bin numbers to the right size
    ReDim iBinArray(0 To iBins - 1)

    'Load the array with the bin numbers
    iBins = DeviceCapabilities(sCurrentPrinter, sPort, _
    DC_BINS, iBinArray(0), 0)

    'Return the array to the calling routine
    GetBinNumbers = iBinArray
End Function

Public Function GetBinNames() As Variant
    On Error Resume Next
    
    'Code adapted from Microsoft KB article Q194789
    'HOWTO: Determine Available PaperBins with DeviceCapabilities API

    Dim iBins As Long
    Dim ct As Long
    Dim sNamesList As String
    Dim sNextString As String
    Dim sPort As String
    Dim sCurrentPrinter As String
    Dim vBins As Variant

    'Get the printer & port name of the current printer
    sPort = Trim$(Mid$(Word.ActivePrinter, InStrRev(Word.ActivePrinter, " ") + 1))
    sCurrentPrinter = Trim$(Left$(Word.ActivePrinter, _
        InStr(Word.ActivePrinter, " on ")))

    'Find out how many printer bins there are
    iBins = DeviceCapabilities(sCurrentPrinter, sPort, _
        DC_BINS, ByVal vbNullString, 0)

    'Set the string to the right size to hold all the bin names
    '24 chars per name
    sNamesList = String(24 * iBins, 0)

    'Load the string with the bin names
    iBins = DeviceCapabilities(sCurrentPrinter, sPort, _
        DC_BINNAMES, ByVal sNamesList, 0)

    'Set the array of bin names to the right size
    ReDim vBins(0 To iBins - 1)
    For ct = 0 To iBins - 1
        'Get each bin name in turn and assign to the next item in the array
        sNextString = Mid(sNamesList, 24 * ct + 1, 24)
        vBins(ct) = Left(sNextString, InStr(1, sNextString, Chr(0)) - 1)
    Next ct

    'Return the array to the calling routine
    GetBinNames = vBins
End Function
Sub ptGo(BinNo As Long)
    On Error Resume Next
    With Word.ActiveDocument.PageSetup
        .FirstPageTray = vBinNumbers(BinNo)
        .OtherPagesTray = vBinNumbers(BinNo)
    End With
    If ptSelectAndPrint = True Then
        ActiveDocument.PrintOut
    End If
End Sub
Sub pt0()
    ptGo 0
End Sub
Sub pt1()
    ptGo 1
End Sub
Sub pt2()
    ptGo 2
End Sub
Sub pt3()
    ptGo 3
End Sub
Sub pt4()
    ptGo 4
End Sub
Sub pt5()
    ptGo 5
End Sub
Sub pt6()
    ptGo 6
End Sub
Sub pt7()
    ptGo 7
End Sub
Sub pt8()
    ptGo 8
End Sub
Sub pt9()
    ptGo 9
End Sub
Sub pt10()
    ptGo 10
End Sub
Sub pt11()
    ptGo 11
End Sub
Sub pt12()
    ptGo 12
End Sub