[vba] probleem met printer-lades selecteren

Pagina: 1
Acties:
  • 156 views sinds 30-01-2008
  • Reageer

  • sebasgrif
  • Registratie: Februari 2004
  • Laatst online: 28-01 18:26
Ik heb al eens eerder een vraag gesteld over vba hier en ben toen goed op weg geholpen. nu ben ik tegen een ander probleem opgelopen waar ik absoluut niet uitkom, ook met behulp van msdn, google en GoT search kom ik nog niet erg ver.

Ik ben een programma voor gebruikers aan het maken waarbij ze vanaf 1 form alle nodige opties kun defineren en ook niets meer dan dat. hierop staan dus ook de benodige lade's voor de eerste pagina en de overige pagina's. Vanuit de windows api kan je deze lade's opvragen en in bijvoorbeeld een listbox zetten. er komen 2 waarde's uit deze api, een naam en een nummer. het nummer is nodig om de printer aan te sturen, de naam is mooi voor in de listbox. met de volgende code kan ik wel de lades laten zien en selecteren maar ik krijg het niet voor elkaar om het verder aan de praat te krijgen, is er iemand die mij hier mee kan helpen?
alvast bedankt!

userform2:
code:
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
Private Sub PrintCombobox_Change()

    ActivePrinter = PrintTekstBox.Value
    
End Sub

Private Sub PrintKnop_Click()

    Dim TestVariable As String

    If AllesOptionButton = True Then
        TestVariable = WdPrintOutRange.wdPrintAllDocument
    ElseIf HuidigePaginaOptionButton = True Then
        TestVariable = WdPrintOutRange.wdPrintCurrentPage
    ElseIf SelectieOptionButton = True Then
        TestVariable = WdPrintOutRange.wdPrintSelection
    ElseIf AfdrukbereikOptionButton = True Then
        TestVariable = WdPrintOutRange.wdPrintRangeOfPages
    End If
    
    If PositieStaandButton = True Then
        ActiveDocument.PageSetup.Orientation = wdOrientPortrait
    ElseIf PositieLiggendButton = True Then
        ActiveDocument.PageSetup.Orientation = wdOrientLandscape
    End If
   
    ActiveDocument.PageSetup.FirstPageTray = ListBox1.ListIndex 'P1LadeVariable
    ActiveDocument.PageSetup.OtherPagesTray = ListBox2.ListIndex 'RestLadeVariable
    ActiveDocument.PageSetup.TwoPagesOnOne = TweePaginasPerVelCheckBox.Value   
    
    ActiveDocument.PrintOut Range:=TestVariable, Collate:=SorterenCheckBox.Value, _
Copies:=AantalExemplarenTextBox.Value, Pages:=PaginaBereikTextBox.Value
    
    End

End Sub

Private Sub AnnulerenKnop_Click()

   End
   
End Sub

Private Sub UserForm_Initialize()   

    Module1.EnumeratePrintersWin
    PrintCombobox.Value = ActivePrinter
       
    Module1.GetBinNames
    Module1.GetBinNumbers
      
End Sub


Module1:
code:
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
Option Explicit

Const PRINTER_ENUM_CONNECTIONS = &H4
Const PRINTER_ENUM_LOCAL = &H2

Private Const DC_BINS = 6
Private Const DC_BINNAMES = 12
    
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

Type PRINTER_INFO_1

    flags As Long
    pDescription As String
    PName As String
    PComment As String

End Type

Type PRINTER_INFO_4
    
    pPrinterName As String
    pServerName As String
    Attributes As Long

End Type

Declare Function EnumPrinters Lib "winspool.drv" Alias "EnumPrintersA"_ 
 (ByVal flags As Long, ByVal name As String, ByVal Level As Long, pPrinterEnum As_
 Long, ByVal cdBuf As Long, pcbNeeded As Long, pcReturned As Long) As Long
Declare Function PtrToStr Lib "Kernel32" _
Alias "lstrcpyA" (ByVal RetVal As String, ByVal Ptr As Long) As Long
Declare Function StrLen Lib "Kernel32" Alias "lstrlenA" (ByVal Ptr As Long) As Long
            
Public Function EnumeratePrintersWin()

    Dim Success As Boolean, cbRequired As Long, cbBuffer As Long
    Dim Buffer() As Long, nEntries As Long
    Dim I As Long, PFlags As Long, PDesc As String, PName As String
    Dim PComment As String, Temp As Long

    cbBuffer = 3072
    ReDim Buffer((cbBuffer \ 4) - 1) As Long
    Success = EnumPrinters(PRINTER_ENUM_CONNECTIONS Or _ 
PRINTER_ENUM_LOCAL, vbNullString, 1, Buffer(0), cbBuffer, cbRequired, nEntries)
   
    If Success Then
        
        If cbRequired > cbBuffer Then
            
            cbBuffer = cbRequired
            'Debug.Print "Buffer too small.  Trying again with " & cbBuffer & " bytes."
            ReDim Buffer(cbBuffer \ 4) As Long
            Success = EnumPrinters(PRINTER_ENUM_CONNECTIONS Or PRINTER_ENUM_LOCAL, _
vbNullString, 1, Buffer(0), cbBuffer, cbRequired, nEntries)
        
            If Not Success Then
                
                'Debug.Print "Error enumerating printers."
                Exit Function
            
            End If
    
        End If
   
        'Debug.Print "There are " & nEntries & " local and connected printers."
   
        For I = 0 To nEntries - 1
            
            PFlags = Buffer(4 * I)
            PDesc = Space$(StrLen(Buffer(I * 4 + 1)))
            Temp = PtrToStr(PDesc, Buffer(I * 4 + 1))
            PName = Space$(StrLen(Buffer(I * 4 + 2)))
            Temp = PtrToStr(PName, Buffer(I * 4 + 2))
            PComment = Space$(StrLen(Buffer(I * 4 + 2)))
            Temp = PtrToStr(PComment, Buffer(I * 4 + 2))
            'Debug.Print PFlags, PDesc, PName, PComment
      
            UserForm2.PrintCombobox.AddItem PDesc
            UserForm2.PrintTekstBox.Value = PComment
        
            Next I
        
        Else
      
        'Debug.Print "Error enumerating printers."
   
    End If
    
End Function

Public Function GetBinNames() As Variant
    
    '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$(ActivePrinter, InStrRev(ActivePrinter, " ") + 1))
    sCurrentPrinter = Trim$(Left$(ActivePrinter, InStr(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
    
    'UserForm2.ListBox1.List = GetBinNames
    'UserForm2.ListBox2.List = GetBinNames


End Function

Public Function GetBinNumbers() As Variant

    '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$(ActivePrinter, InStrRev(ActivePrinter, " ") + 1))
    sCurrentPrinter = Trim$(Left$(ActivePrinter, InStr(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
    
     UserForm2.ListBox1.List = GetBinNumbers
     UserForm2.ListBox2.List = GetBinNumbers

End Function