以程式設計方式擷取印表機功能

表機 集合與 印表機 物件僅允許您設定或取回印表機的設定。 若要判斷印表機的功能 (例如能支援的紙張種類或紙匣),您就必須呼叫 Windows 應用程式介面 (API) 的 DeviceCapabilities 函數。 這超出本主題的範圍,無法詳細說明,但以下來自 modPrinters PrinterDemo.mdb模組的範例程式碼,示範如何取得印表機支援的紙張尺寸和紙箱的名稱與 ID。

下列程式碼應該要貼入模組的一般宣告區段中。

' 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 

下列程序會使用 DeviceCapabilities API 函數顯示訊息方塊,其中包含預設印表機的名稱及其所能支援之紙張大小的清單。

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

下列程序會使用 DeviceCapabilities API 函數來顯示訊息方塊,其中包含預設印表機的名稱及其所能支援之紙匣的清單。

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

支援和意見反應

有關於 Office VBA 或這份文件的問題或意見反應嗎? 如需取得支援服務並提供意見反應的相關指導,請參閱 Office VBA 支援與意見反應