[VBA程序]：如何列出可用的打印机配置及打印样式？

neteasy

在VB中如何列出cad可用的打印机配置及打印样式？就是控制面板中的打印机及打印样式管理器中的内容。

efan2000

枚举打印机要使用API函数。

2. 
   
3.   [FONT=courier new]
   
4. ' Get information about all of the local printers using structure 1.  Note how
   
5. ' the elements of the array are loaded into an array of data structures manually.  Also
   
6. ' note how the following special declares must be used to allow numeric string pointers
   
7. ' to be used in place of strings:
   
8. Private Declare Function lstrcpy Lib "kernel32.dll" Alias "lstrcpyA" (ByVal lpString1 As String, ByVal lpString2 As Long) As Long
   
9. Private Declare Function lstrlen Lib "kernel32.dll" Alias "lstrlenA" (ByVal lpString As Long) As Long
   
10. Private Declare Function EnumPrinters Lib "winspool.drv" Alias "EnumPrintersA" (ByVal flags As Long, ByVal name As String, ByVal Level As Long, pPrinterEnum As Long, ByVal cdBuf As Long, pcbNeeded As Long, pcReturned As Long) As Long
    
11. Const PRINTER_ENUM_LOCAL = &H2
    
12. Private Type PRINTER_INFO_1
    
13.         flags As Long
    
14.         pDescription As String
    
15.         pName As String
    
16.         pComment As String
    
17. End Type
    
18. Private Sub Form_Load()
    
19.     'KPD-Team 1999
    
20.     'URL: [url]http://www.allapi.net/[/url]
    
21.     'E-Mail: [email]KPDTeam@Allapi.net[/email]
    
22.     Dim longbuffer() As Long  ' resizable array receives information from the function
    
23.     Dim printinfo() As PRINTER_INFO_1  ' values inside longbuffer() will be put into here
    
24.     Dim numbytes As Long  ' size in bytes of longbuffer()
    
25.     Dim numneeded As Long  ' receives number of bytes necessary if longbuffer() is too small
    
26.     Dim numprinters As Long  ' receives number of printers found
    
27.     Dim c As Integer, retval As Long  ' counter variable & return value
    
28.     Me.AutoRedraw = True 'Set current graphic mode to persistent
    
29.     ' Get information about the local printers
    
30.     numbytes = 3076  ' should be sufficiently big, but it may not be
    
31.     ReDim longbuffer(0 To numbytes / 4) As Long  ' resize array -- note how 1 Long = 4 bytes
    
32.     retval = EnumPrinters(PRINTER_ENUM_LOCAL, "", 1, longbuffer(0), numbytes, numneeded, numprinters)
    
33.     If retval = 0 Then  ' try enlarging longbuffer() to receive all necessary information
    
34.         numbytes = numneeded
    
35.         ReDim longbuffer(0 To numbytes / 4) As Long  ' make it large enough
    
36.         retval = EnumPrinters(PRINTER_ENUM_LOCAL, "", 1, longbuffer(0), numbytes, numneeded, numprinters)
    
37.         If retval = 0 Then ' failed again!
    
38.             Debug.Print "Could not successfully enumerate the printes."
    
39.         End  ' abort program
    
40.     End If
    
41.     End If
    
42.     ' Convert longbuffer() data into printinfo()
    
43.     ReDim printinfo(0 To numprinters - 1) As PRINTER_INFO_1  ' room for each printer
    
44.     For c = 0 To numprinters - 1  ' loop, putting each set of information into each element
    
45.         ' longbuffer(4 * c) = .flags, longbuffer(4 * c + 1) = .pDescription, etc.
    
46.         ' For each string, the string is first buffered to provide enough room, and then the string is copied.
    
47.         printinfo(c).flags = longbuffer(4 * c)
    
48.         printinfo(c).pDescription = Space(lstrlen(longbuffer(4 * c + 1)))
    
49.         retval = lstrcpy(printinfo(c).pDescription, longbuffer(4 * c + 1))
    
50.         printinfo(c).pName = Space(lstrlen(longbuffer(4 * c + 2)))
    
51.         retval = lstrcpy(printinfo(c).pName, longbuffer(4 * c + 2))
    
52.         printinfo(c).pComment = Space(lstrlen(longbuffer(4 * c + 3)))
    
53.         retval = lstrcpy(printinfo(c).pComment, longbuffer(4 * c + 3))
    
54.     Next c
    
55.     ' Display name of each printer
    
56.     For c = 0 To numprinters - 1
    
57.         Me.Print "Name of printer"; c + 1; " is: "; printinfo(c).pName
    
58.     Next c
    
59. End Sub
    
60.   [/FONT]
    

<br />   [FONT=courier new]<br /> ' Get information about all of the local printers using structure 1.  Note how<br /> ' the elements of the array are loaded into an array of data structures manually.  Also<br /> ' note how the following special declares must be used to allow numeric string pointers<br /> ' to be used in place of strings:<br /> Private Declare Function lstrcpy Lib "kernel32.dll" Alias "lstrcpyA" (ByVal lpString1 As String, ByVal lpString2 As Long) As Long<br /> Private Declare Function lstrlen Lib "kernel32.dll" Alias "lstrlenA" (ByVal lpString As Long) As Long<br /> Private Declare Function EnumPrinters Lib "winspool.drv" Alias "EnumPrintersA" (ByVal flags As Long, ByVal name As String, ByVal Level As Long, pPrinterEnum As Long, ByVal cdBuf As Long, pcbNeeded As Long, pcReturned As Long) As Long<br /> Const PRINTER_ENUM_LOCAL = &H2<br /> Private Type PRINTER_INFO_1<br />         flags As Long<br />         pDescription As String<br />         pName As String<br />         pComment As String<br /> End Type<br /> Private Sub Form_Load()<br />     'KPD-Team 1999<br />     'URL: [url]http://www.allapi.net/[/url]<br />     'E-Mail: [email]KPDTeam@Allapi.net[/email]<br />     Dim longbuffer() As Long  ' resizable array receives information from the function<br />     Dim printinfo() As PRINTER_INFO_1  ' values inside longbuffer() will be put into here<br />     Dim numbytes As Long  ' size in bytes of longbuffer()<br />     Dim numneeded As Long  ' receives number of bytes necessary if longbuffer() is too small<br />     Dim numprinters As Long  ' receives number of printers found<br />     Dim c As Integer, retval As Long  ' counter variable & return value<br />     Me.AutoRedraw = True 'Set current graphic mode to persistent<br />     ' Get information about the local printers<br />     numbytes = 3076  ' should be sufficiently big, but it may not be<br />     ReDim longbuffer(0 To numbytes / 4) As Long  ' resize array -- note how 1 Long = 4 bytes<br />     retval = EnumPrinters(PRINTER_ENUM_LOCAL, "", 1, longbuffer(0), numbytes, numneeded, numprinters)<br />     If retval = 0 Then  ' try enlarging longbuffer() to receive all necessary information<br />         numbytes = numneeded<br />         ReDim longbuffer(0 To numbytes / 4) As Long  ' make it large enough<br />         retval = EnumPrinters(PRINTER_ENUM_LOCAL, "", 1, longbuffer(0), numbytes, numneeded, numprinters)<br />         If retval = 0 Then ' failed again!<br />             Debug.Print "Could not successfully enumerate the printes."<br />         End  ' abort program<br />     End If<br />     End If<br />     ' Convert longbuffer() data into printinfo()<br />     ReDim printinfo(0 To numprinters - 1) As PRINTER_INFO_1  ' room for each printer<br />     For c = 0 To numprinters - 1  ' loop, putting each set of information into each element<br />         ' longbuffer(4 * c) = .flags, longbuffer(4 * c + 1) = .pDescription, etc.<br />         ' For each string, the string is first buffered to provide enough room, and then the string is copied.<br />         printinfo(c).flags = longbuffer(4 * c)<br />         printinfo(c).pDescription = Space(lstrlen(longbuffer(4 * c + 1)))<br />         retval = lstrcpy(printinfo(c).pDescription, longbuffer(4 * c + 1))<br />         printinfo(c).pName = Space(lstrlen(longbuffer(4 * c + 2)))<br />         retval = lstrcpy(printinfo(c).pName, longbuffer(4 * c + 2))<br />         printinfo(c).pComment = Space(lstrlen(longbuffer(4 * c + 3)))<br />         retval = lstrcpy(printinfo(c).pComment, longbuffer(4 * c + 3))<br />     Next c<br />     ' Display name of each printer<br />     For c = 0 To numprinters - 1<br />         Me.Print "Name of printer"; c + 1; " is: "; printinfo(c).pName<br />     Next c<br /> End Sub<br />   [/FONT]<br />

efan2000

打印机样式应该就是打印机配置，可以使用Document的 PlotConfigurations 属性返回所有的打印配置集合。然后通过枚举PlotConfigurations就可以查看每个配置情况了。

2. 
   
3.   [FONT=courier new]
   
4. Sub Example_CopyFrom()
   
5.     ' This example will create two new plot configurations and will use
   
6.     ' the CopyFrom method to duplicate the settings in the first plot configuration
   
7.     ' to the second plot configuration.
   
8. 
   
9.     Dim PlotConfigurations As AcadPlotConfigurations
   
10.     Dim PlotConfiguration As AcadPlotConfiguration
    
11.     Dim NewPC1 As AcadPlotConfiguration, NewPC2 As AcadPlotConfiguration
    
12.    
    
13.     ' Get PlotConfigurations collection from document object
    
14.     Set PlotConfigurations = ThisDrawing.PlotConfigurations
    
15.    
    
16.     ' Add a new plot configuration and customize some of the properties
    
17.     Set NewPC1 = PlotConfigurations.Add("NEW_CONFIGURATION1")
    
18.         NewPC1.PlotRotation = ac270degrees
    
19.         NewPC1.PlotHidden = True
    
20.         NewPC1.PaperUnits = acMillimeters
    
21.    
    
22.     ' Add another plot configuration and leave default values intact
    
23.     Set NewPC2 = PlotConfigurations.Add("NEW_CONFIGURATION2")
    
24.    
    
25.     ' Show plot configuration settings before we copy information from PC1
    
26.     GoSub VIEWPC2SETTINGS
    
27.    
    
28.     ' Copy setting information from plot configuration to plot configuration
    
29.     NewPC2.CopyFrom NewPC1
    
30.    
    
31.     ' Show plot configuration settings after we copy information from plot configuration
    
32.     GoSub VIEWPC2SETTINGS
    
33.    
    
34.     Exit Sub
    
35.    
    
36. VIEWPC2SETTINGS:
    
37.     MsgBox "The settings for NEW_CONFIGURATION2 are: " & vbCrLf & _
    
38.             "Plot Rotation: " & NewPC2.PlotRotation & vbCrLf & _
    
39.             "Plot Hidden: " & NewPC2.PlotHidden & vbCrLf & _
    
40.             "Paper Units: " & NewPC2.PaperUnits
    
41. 
    
42.     Return
    
43. End Sub
    
44.   [/FONT]
    

<br />   [FONT=courier new]<br /> Sub Example_CopyFrom()<br />     ' This example will create two new plot configurations and will use<br />     ' the CopyFrom method to duplicate the settings in the first plot configuration<br />     ' to the second plot configuration.<br /> <br />     Dim PlotConfigurations As AcadPlotConfigurations<br />     Dim PlotConfiguration As AcadPlotConfiguration<br />     Dim NewPC1 As AcadPlotConfiguration, NewPC2 As AcadPlotConfiguration<br />     <br />     ' Get PlotConfigurations collection from document object<br />     Set PlotConfigurations = ThisDrawing.PlotConfigurations<br />     <br />     ' Add a new plot configuration and customize some of the properties<br />     Set NewPC1 = PlotConfigurations.Add("NEW_CONFIGURATION1")<br />         NewPC1.PlotRotation = ac270degrees<br />         NewPC1.PlotHidden = True<br />         NewPC1.PaperUnits = acMillimeters<br />     <br />     ' Add another plot configuration and leave default values intact<br />     Set NewPC2 = PlotConfigurations.Add("NEW_CONFIGURATION2")<br />     <br />     ' Show plot configuration settings before we copy information from PC1<br />     GoSub VIEWPC2SETTINGS<br />     <br />     ' Copy setting information from plot configuration to plot configuration<br />     NewPC2.CopyFrom NewPC1<br />     <br />     ' Show plot configuration settings after we copy information from plot configuration<br />     GoSub VIEWPC2SETTINGS<br />     <br />     Exit Sub<br />     <br /> VIEWPC2SETTINGS:<br />     MsgBox "The settings for NEW_CONFIGURATION2 are: " & vbCrLf & _<br />             "Plot Rotation: " & NewPC2.PlotRotation & vbCrLf & _<br />             "Plot Hidden: " & NewPC2.PlotHidden & vbCrLf & _<br />             "Paper Units: " & NewPC2.PaperUnits<br /> <br />     Return<br /> End Sub<br />   [/FONT]<br />