Recuperar as capacidades da impressora via programação

A coleção Impressoras e o objeto Impressora permitem que você apenas defina ou recupere as configurações de uma impressora. Para determinar os recursos da impressora, como tipos ou bandejas de papel compatíveis, você de usar chamadas para a função DeviceCapabilities da API do Windows. Está além do escopo deste tópico para abordar isso em detalhes, mas o exemplo de código a seguir do módulo modPrinters do download de exemplo PrinterDemo.mdb demonstra como recuperar os nomes e as IDs do tamanho do papel com suporte e caixas de papel para uma impressora.

O código a seguir deve ser passado para a seção de declarações gerais de um módulo.

' Declaration for the DeviceCapabilities function API call. 
Private Declare Function DeviceCapabilities Lib "winspool.drv" _ 
    Alias "DeviceCapabilitiesA" (ByVal lpsDeviceName As String, _ 
    ByVal lpPort As String, ByVal iIndex As Long, lpOutput As Any, _ 
    ByVal lpDevMode As Long) As Long 
     
' DeviceCapabilities function constants. 
Private Const DC_PAPERNAMES = 16 
Private Const DC_PAPERS = 2 
Private Const DC_BINNAMES = 12 
Private Const DC_BINS = 6 
Private Const DEFAULT_VALUES = 0 

O procedimento a seguir usa a função API DeviceCapabilities para exibir uma caixa de mensagens com o nome da impressora padrão e uma lista dos tamanhos de papel suportados.

Sub GetPaperList() 
    Dim lngPaperCount As Long 
    Dim lngCounter As Long 
    Dim hPrinter As Long 
    Dim strDeviceName As String 
    Dim strDevicePort As String 
    Dim strPaperNamesList As String 
    Dim strPaperName As String 
    Dim intLength As Integer 
    Dim strMsg As String 
    Dim aintNumPaper() As Integer 
     
    On Error GoTo GetPaperList_Err 
     
    ' Get the name and port of the default printer. 
    strDeviceName = Application.Printer.DeviceName 
    strDevicePort = Application.Printer.Port 
     
    ' Get the count of paper names supported by the printer. 
    lngPaperCount = DeviceCapabilities(lpsDeviceName:=strDeviceName, _ 
        lpPort:=strDevicePort, _ 
        iIndex:=DC_PAPERNAMES, _ 
        lpOutput:=ByVal vbNullString, _ 
        lpDevMode:=DEFAULT_VALUES) 
     
    ' Re-dimension the array to the count of paper names. 
    ReDim aintNumPaper(1 To lngPaperCount) 
     
    ' Pad the variable to accept 64 bytes for each paper name. 
    strPaperNamesList = String(64 * lngPaperCount, 0) 
 
    ' Get the string buffer of all paper names supported by the printer. 
    lngPaperCount = DeviceCapabilities(lpsDeviceName:=strDeviceName, _ 
        lpPort:=strDevicePort, _ 
        iIndex:=DC_PAPERNAMES, _ 
        lpOutput:=ByVal strPaperNamesList, _ 
        lpDevMode:=DEFAULT_VALUES) 
     
    ' Get the array of all paper numbers supported by the printer. 
    lngPaperCount = DeviceCapabilities(lpsDeviceName:=strDeviceName, _ 
        lpPort:=strDevicePort, _ 
        iIndex:=DC_PAPERS, _ 
        lpOutput:=aintNumPaper(1), _ 
        lpDevMode:=DEFAULT_VALUES) 
     
    ' List the available paper names. 
    strMsg = "Papers available for " & strDeviceName & vbCrLf 
    For lngCounter = 1 To lngPaperCount 
         
        ' Parse a paper name from the string buffer. 
        strPaperName = Mid(String:=strPaperNamesList, _ 
            Start:=64 * (lngCounter - 1) + 1, Length:=64) 
        intLength = VBA.InStr(Start:=1, String1:=strPaperName, String2:=Chr(0)) - 1 
        strPaperName = Left(String:=strPaperName, Length:=intLength) 
         
        ' Add a paper number and name to text string for the message box. 
        strMsg = strMsg & vbCrLf & aintNumPaper(lngCounter) _ 
            & vbTab & strPaperName 
             
    Next lngCounter 
         
    ' Show the paper names in a message box. 
    MsgBox Prompt:=strMsg 
 
GetPaperList_End: 
    Exit Sub 
     
GetPaperList_Err: 
    MsgBox Prompt:=Err.Description, Buttons:=vbCritical & vbOKOnly, _ 
        Title:="Error Number " & Err.Number & " Occurred" 
    Resume GetPaperList_End 
     
End Sub

O procedimento a seguir usa a função API DeviceCapabilities para exibir uma caixa de mensagens com o nome da impressora padrão e uma lista das caixas de papel que ela dá suporte.

Sub GetBinList(strName As String) 
' Uses the DeviceCapabilities API function to display a 
' message box with the name of the default printer and a 
' list of the paper bins it supports. 
 
    Dim lngBinCount As Long 
    Dim lngCounter As Long 
    Dim hPrinter As Long 
    Dim strDeviceName As String 
    Dim strDevicePort As String 
    Dim strBinNamesList As String 
    Dim strBinName As String 
    Dim intLength As Integer 
    Dim strMsg As String 
    Dim aintNumBin() As Integer 
     
    On Error GoTo GetBinList_Err 
     
    ' Get name and port of the default printer. 
    strDeviceName = Application.Printers(strName).DeviceName 
    strDevicePort = Application.Printers(strName).Port 
     
    ' Get count of paper bin names supported by the printer. 
    lngBinCount = DeviceCapabilities(lpsDeviceName:=strDeviceName, _ 
        lpPort:=strDevicePort, _ 
        iIndex:=DC_BINNAMES, _ 
        lpOutput:=ByVal vbNullString, _ 
        lpDevMode:=DEFAULT_VALUES) 
     
    ' Re-dimension the array to count of paper bins. 
    ReDim aintNumBin(1 To lngBinCount) 
     
    ' Pad variable to accept 24 bytes for each bin name. 
    strBinNamesList = String(Number:=24 * lngBinCount, Character:=0) 
 
    ' Get string buffer of paper bin names supported by the printer. 
    lngBinCount = DeviceCapabilities(lpsDeviceName:=strDeviceName, _ 
        lpPort:=strDevicePort, _ 
        iIndex:=DC_BINNAMES, _ 
        lpOutput:=ByVal strBinNamesList, _ 
        lpDevMode:=DEFAULT_VALUES) 
         
    ' Get array of paper bin numbers supported by the printer. 
    lngBinCount = DeviceCapabilities(lpsDeviceName:=strDeviceName, _ 
        lpPort:=strDevicePort, _ 
        iIndex:=DC_BINS, _ 
        lpOutput:=aintNumBin(1), _ 
        lpDevMode:=0) 
         
    ' List available paper bin names. 
    strMsg = "Paper bins available for " & strDeviceName & vbCrLf 
    For lngCounter = 1 To lngBinCount 
         
        ' Parse a paper bin name from string buffer. 
        strBinName = Mid(String:=strBinNamesList, _ 
            Start:=24 * (lngCounter - 1) + 1, _ 
            Length:=24) 
        intLength = VBA.InStr(Start:=1, _ 
            String1:=strBinName, String2:=Chr(0)) - 1 
        strBinName = Left(String:=strBinName, _ 
                Length:=intLength) 
 
        ' Add bin name and number to text string for message box. 
        strMsg = strMsg & vbCrLf & aintNumBin(lngCounter) _ 
            & vbTab & strBinName 
             
    Next lngCounter 
         
    ' Show paper bin numbers and names in message box. 
    MsgBox Prompt:=strMsg 
     
GetBinList_End: 
    Exit Sub 
GetBinList_Err: 
    MsgBox Prompt:=Err.Description, Buttons:=vbCritical & vbOKOnly, _ 
        Title:="Error Number " & Err.Number & " Occurred" 
    Resume GetBinList_End 
End Sub

Suporte e comentários

Tem dúvidas ou quer enviar comentários sobre o VBA para Office ou sobre esta documentação? Confira Suporte e comentários sobre o VBA para Office a fim de obter orientação sobre as maneiras pelas quais você pode receber suporte e fornecer comentários.