Christian..
the function below returns an array of the installed printers
( in complete localized strings)
Can be called when you're filling a combobox on a form or in a dropdown
from worksheet as in demo (as in the demo)
Sub Demo()
Dim v As Variant
Dim i As Long
Workbooks.Add xlWBATWorksheet
v = PrinterList
For i = LBound(v) To UBound(v)
Cells(i + 1, 1) = v(i)
Cells(i + 1, 2).Formula = "=printerlist(" & i & ")"
Next
Cells(1, 3).Resize(i, 1).FormulaArray = "=transpose(printerlist())"
Cells(1, 4).Resize(1, i).FormulaArray = "=printerlist()"
Cells(1, 1).CurrentRegion.EntireColumn.AutoFit
MsgBox Join(v, vbNewLine)
End Sub
Function PrinterList(Optional PrinterNr As Integer = -1)
Dim i%, n%, lRet&, sBuf$, sOn$, sPort$, aPrn
Const lSize& = 1024, sKey$ = "devices"
'-----------------------------------------------------------
'Author: keepITcool 1st posted nl.office.excel 23/10/2003
'Function returns a zerobased array of installed printers
'include for xl97: supplemental functions split/join/replace
'-----------------------------------------------------------
'Get localized Connection string
aPrn = Split(Excel.ActivePrinter)
sOn = " " & aPrn(UBound(aPrn) - 1) & " "
'Read Printers
sBuf = Space(lSize)
lRet = GetProfileString(sKey, vbNullString, vbNullString, sBuf, lSize)
If lRet = 0 Then Exit Function
'Make Array from String
aPrn = Split(Left(sBuf, lRet - 1), vbNullChar)
'Add Port for each Printer
For n = LBound(aPrn) To UBound(aPrn)
sBuf = Space(lSize)
lRet = GetProfileString(sKey, aPrn(n), vbNullString, sBuf, lSize)
sPort = Mid(sBuf, InStr(sBuf, ",") + 1, lRet - InStr(sBuf, ","))
aPrn(n) = aPrn(n) & sOn & sPort
Next
'Sort
qSort aPrn
'Return the results
If PrinterNr = -1 Then PrinterList = aPrn Else PrinterList = aPrn( _
PrinterNr)
End Function
Public Sub qSort(v, Optional n& = True, Optional m& = True)
Dim i&, j&, p, t
If n = True Then n = LBound(v): If m = True Then m = UBound(v)
i = n: j = m: p = v((n + m) \ 2)
While (i <= j)
While (v(i) < p And i < m): i = i + 1: Wend
While (v(j) > p And j > n): j = j - 1: Wend
If (i <= j) Then
t = v(i): v(i) = v(j): v(j) = t
i = i + 1: j = j - 1
End If
Wend
If (n < j) Then qSort v, n, j
If (i < m) Then qSort v, i, m
End Sub
'**********************************************************
' Optional Split function for xl97
'**********************************************************
#If VBA6 Then
#Else
Function Split(sText As String, _
Optional sDelim As String = " ") As Variant
Dim i%, sFml$, v0, v1
Const sDQ$ = """"
If sDelim = vbNullChar Then
sDelim = Chr(7)
sText = Replace(sText, vbNullChar, sDelim)
End If
sFml = "{""" & Application.Substitute(sText, sDelim, """,""") & """}"
v1 = Evaluate(sFml)
'Return 0 based for compatibility
ReDim v0(0 To UBound(v1) - 1)
For i = 0 To UBound(v0): v0(i) = v1(i + 1): Next
Split = v0
End Function
#End If
keepITcool
< email : keepitcool chello nl (with @ and .) >
< homepage:
http://members.chello.nl/keepitcool >
