VBA Code zum Laufen bringen
04.05.2004 18:00:59
Thorsten
ich habe ein Stück VBA Quellcode, den ich gerne ausführen möchte. Leider bin ich nicht so fit in VBA...
Wie sieht ein komplettes, ausführbares VBA Modul aus, daß folgende Funktionen beinhalten soll:
Option Explicit
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
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
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
End Function
Die Funktion soll über:
ListBox1.List = GetBinNames
aufgerufen werden. Wie bekomme ich das hin???
Danke für die Hilfe!
T