Stampe d'autore

In Excel alcune volte mi è capitato di dover impostare, anche temporaneamente, una stampante diversa da quella predefinita... Application.ActivePrinter è piuttosto ostico nell'impostazione di questa proprietà perchè bisogna conoscere esattamente sia il nome della stampante desiderata sia la locazione (es. "su Ne01:" per una stampante di rete nelle versioni Excel localizzate in italiano). Ecco quindi un metodo che sfrutta un paio di API per aggirare l'ostacolo. Il codice seguente va incollato in un modulo; per avviarlo si esegue la sub Main. La procedura presenta in una inputbox l'elenco delle stampanti installate nel sistema (non elenca quella già predefinita), numerate da 1 in poi; si indica il numero della stampante desiderata e si conferma. Viene quindi stampato il foglio attivo (la procedura è nata in Excel ma si può adattare al resto del mondo Office).
'in un modulo
Option Explicit

'seleziona una stampante e la rende temporaneamente predefinita

Type PRINTER_INFO_1
    flags As Long
    pPDescription As Long
    pName As Long
    pComment As Long
End Type

Type PRINTER_INFO_5
    pPrinterName As Long
    pPortName As Long
    Attributes As Long
    DeviceNotSelectedTimeout As Long
    TransmissionRetryTimeout As Long
End Type

Private Const PRINTER_ENUM_LOCAL = &H2
Private Declare Function Enumprinters Lib "winspool.drv" Alias "EnumPrintersA"_
(ByVal flags As Long, ByVal Name As String, ByVal Level As Long, pPrinterEnum _
As Any, ByVal cdBuf As Long, pcbNeeded As Long, pcReturned As Long) As Long
Private Declare Sub MoveMemory Lib "KERNEL32" Alias "RtlMoveMemory" (Dest As _
Any, Source As Any, ByVal length&)
Private Declare Function SetDefaultPrinter Lib "winspool.drv" Alias _
"SetDefaultPrinterA" (ByVal pszPrinter As String) As Long


Sub Main()
Dim original_printer As String, new_printer As String, i As Integer

    original_printer = ActivePrinter
    new_printer = EnumPrinter
    If new_printer = "" Then Exit Sub
    SetDefaultPrinter new_printer
    ActiveSheet.PrintOut
    
    i = InStrRev(original_printer, " ", InStrRev(original_printer, " ")) - 1
    SetDefaultPrinter Left(original_printer, i)
End Sub


Private Function EnumPrinter()
    Dim rc As Long, i As Integer, nSizeOfStruct As Long, Level As Long
    Dim pPrinterEnum() As Byte, pcbNeeded As Long, pcReturned As Long
    Dim PI_1() As PRINTER_INFO_1
    Dim Msg As String
    Dim v As Variant
    Dim ChgP As Integer
    
    Level = 1
    rc = Enumprinters(PRINTER_ENUM_LOCAL, vbNullString, Level, ByVal 0&, 0, pcbNeeded, pcReturned)
    ReDim pPrinterEnum(pcbNeeded - 1) As Byte
    rc = Enumprinters(PRINTER_ENUM_LOCAL, vbNullString, Level, _
pPrinterEnum(0), pcbNeeded, pcbNeeded, pcReturned)
    ReDim PI_1(pcReturned - 1) As PRINTER_INFO_1
    nSizeOfStruct = Len(PI_1(0))
    Msg = "Digita il numero della nuova stampante predefinita:" & vbCrLf
    For i = 0 To pcReturned - 1
        Call MoveMemory(PI_1(i), pPrinterEnum(nSizeOfStruct * i), _
nSizeOfStruct)
        Msg = Msg & i + 1 & " > " & gGetStr(PI_1(i).pName, 64) & vbCrLf
    Next i
    v = InputBox(Msg)
    If Trim(v) = "" Then EnumPrinter = "": Exit Function
    ChgP = v
    EnumPrinter = gGetStr(PI_1(ChgP - 1).pName, 64)
End Function

Private Function gGetStr(pString As Long, nBytes As Long) As String
    ReDim BufArray(nBytes) As Byte
    Call MoveMemory(BufArray(0), ByVal pString, nBytes)
    gGetStr = gGetStrBuffer(StrConv(BufArray(), vbUnicode))
End Function

Private Function gGetStrBuffer(sString As String) As String
    If InStr(sString, vbNullChar) Then
        gGetStrBuffer = Left$(sString, InStr(sString, vbNullChar) - 1)
    Else
    gGetStrBuffer = sString
    End If
End Function

posted @ venerdì 28 marzo 2014 09:13

Print

Comments on this entry:

No comments posted yet.

Your comment:



 (will not be displayed)


 
 
 
Please add 6 and 4 and type the answer here:
 

Live Comment Preview: