在ACCESS實現(xiàn)自定義紙張

andymark

在ACCESS自定義紙張源碼

窗體代碼：

1. Private Sub CmdNew_Click()
   
2.     Dim PrinterName  As String
   
3.     Dim FormName As String
   
4.     Dim FormSize As SIZEL
   
5.     Dim PrinterHandle As Long
   
6.     Dim LngWidth As Long
   
7.     Dim LngHeight As Long
   
8.    
   
9.     If IsNull(Me.TxtNewStyle) Then
   
10.        MsgBox "請輸入要創(chuàng)建的打印格式"
    
11.        Me.TxtNewStyle.SetFocus
    
12.        Exit Sub
    
13.     End If
    
14.    
    
15.     If IsNull(Me.TxtWidth) Then
    
16.        MsgBox "請輸入要創(chuàng)建的打印格式的寬度尺寸(mm)"
    
17.        Me.TxtHeight.SetFocus
    
18.        Exit Sub
    
19.     End If
    
20.    
    
21.     If IsNull(Me.TxtHeight) Then
    
22.        MsgBox "請輸入要創(chuàng)建的打印格式高度尺寸(mm)"
    
23.        Me.TxtWidth.SetFocus
    
24.        Exit Sub
    
25.     End If
    
26.    
    
27.     If Not IsNumeric(Me.TxtWidth) Then
    
28.        MsgBox "打印格式寬度尺寸必須是數(shù)字類型"
    
29.        Me.TxtWidth.SetFocus
    
30.        Exit Sub
    
31.     End If
    
32.    
    
33.     If Not IsNumeric(Me.TxtHeight) Then
    
34.        MsgBox "打印格式高度尺寸必須是數(shù)字類型"
    
35.        Me.TxtWidth.SetFocus
    
36.        Exit Sub
    
37.     End If
    
38.    
    
39.    
    
40.     Dim RetVal As Long
    
41.     Dim Continue As Long
    
42.    
    
43.    
    
44.     PrinterName = GetSrvName(cmbPrinter)
    
45.     FormName = Me.TxtNewStyle
    
46.     LngWidth = Me.TxtWidth * 1000
    
47.     LngHeight = Me.TxtHeight * 1000
    
48.    
    
49.     If PrinterName = "" Then
    
50.         PrinterName = Printer.DeviceName     '當(dāng)前打印機(jī)
    
51.     Else
    
52.         MakeDefaultPrinter PrinterName       '設(shè)置默認(rèn)打印機(jī)
    
53.     End If
    
54. 
    
55.     RetVal = AddCustForm(FormName, Me.hwnd, LngWidth, LngHeight, PrinterName)
    
56. 
    
57.     Select Case RetVal
    
58.         Case FORM_NOT_SELECTED    ' 0
    
59.             ' Selection failed!
    
60.             MsgBox "添加錯誤" & " ErrorCode:" & Err.LastDllError, vbExclamation, _
    
61.                     "錯誤!"
    
62.         Case FORM_SELECTED   ' 1
    
63.            MsgBox FormName & " 打印格式已經(jīng)存在于 " & PrinterName & " ", vbExclamation
    
64.         Case FORM_ADDED      ' 2
    
65.             '//Form added and selected.
    
66.             MsgBox FormName & " 打印格式已經(jīng)添加到 " & PrinterName, vbInformation
    
67.             AddMyForm = True
    
68.    End Select
    
69.    
    
70.   ReGetPaperList
    
71.    
    
72. End Sub
    
73. 
    
74. Private Sub Form_Load()
    
75.     Dim Prn As Printer
    
76.     Dim Obj As AccessObject
    
77.    
    
78.     For Each Prn In Printers
    
79.         Me.cmbPrinter.AddItem Prn.DeviceName
    
80.     Next
    
81.    
    
82.     If cmbPrinter.ListCount > 0 Then
    
83.        cmbPrinter = Printer.DeviceName
    
84.        LstPaper.RowSource = GetPaperList(cmbPrinter)
    
85.     End If
    
86.    
    
87.    For Each Obj In CurrentProject.AllReports
    
88.       Me.LstReport.AddItem Obj.Name
    
89.    Next
    
90. End Sub
    
91. 
    
92. 
    
93. Private Sub cmbPrinter_AfterUpdate()
    
94.     Call ReGetPaperList
    
95. End Sub
    
96. 
    
97. Private Sub CmdDelete_Click()
    
98.     Dim colNetworkPrinters As New Collection
    
99.     Dim srvName As String, tmpName As String
    
100. 
     
101.     Dim FormName As String
     
102.     Dim PrinterName As String
     
103.     Dim i
     
104. 
     
105.     On Error Resume Next
     
106. 
     
107.     If Me.LstPaper.ListIndex < 0 Then
     
108.         MsgBox "請選擇要刪除的紙張格式"
     
109.         Exit Sub
     
110.     End If
     
111.     FormName = Mid(LstPaper, 1, InStr(1, LstPaper, " -") - 1)
     
112.    
     
113.     tmpName = ""
     
114.     srvName = GetSrvName(cmbPrinter)
     
115.    
     
116.     If srvName <> "" Then
     
117.     Call DeleteMyForm(srvName, FormName)
     
118.      End If
     
119.      
     
120.    
     
121.     ReGetPaperList
     
122. End Sub
     
123. 
     
124. Private Sub CmdReport_Click()
     
125.     Dim Rpt As Report
     
126.    ' Dim Prt As Report
     
127.     'Dim accObj As AccessObject
     
128.    
     
129.     Dim strReportName As String
     
130.    
     
131.     If Me.LstReport.ListIndex < 0 Then
     
132.        MsgBox "請選擇報表"
     
133.        Exit Sub
     
134.     End If
     
135.    
     
136.    
     
137.     If Me.LstPaper.ListIndex < 0 Then
     
138.        MsgBox "請選擇打印的紙張類型"
     
139.        Exit Sub
     
140.     End If
     
141.    
     
142.     strReportName = LstReport
     
143.    
     
144.     If IsLoaded(strReportName) Then
     
145.        MsgBox "不能重復(fù)打開相同的報表"
     
146.        Exit Sub
     
147.     End If
     
148.    
     
149.    
     
150.     Select Case strReportName
     
151.    
     
152.       Case "報表1"
     
153.    
     
154.          Set Rpt = New Report_報表1
     
155.    
     
156.       Case "客戶標(biāo)簽"
     
157.    
     
158.          Set Rpt = New Report_客戶標(biāo)簽
     
159.          
     
160.       Case "概覽子報表"
     
161.         
     
162.          Set Rpt = New Report_概覽子報表
     
163.         
     
164.       Case Else
     
165.       
     
166.        Set Rpt = New Report_報表1
     
167.       
     
168.     End Select
     
169.    
     
170.    
     
171.    
     
172.    
     
173.    ' Set Rpt = Reports(strReportName)
     
174.    
     
175. 
     
176. 'Set Rpt = New Report_報表1
     
177.     With Rpt.Printer
     
178.       
     
179.         .PaperSize = GetPaperSize(LstPaper)
     
180.         .Orientation = Me.frameOrientation.Value
     
181.         
     
182.     End With
     
183. 
     
184.     clnClient.Add Item:=Rpt, Key:=CStr(Rpt.hwnd)
     
185.     Rpt.Visible = True
     
186. End Sub
     
187. 
     
188. 
     
189. Private Sub ReGetPaperList()
     
190. '刷新表單(紙張)列表
     
191.     If Not IsNull(Me.cmbPrinter) Then
     
192.        LstPaper.RowSource = ""
     
193.        LstPaper.RowSource = GetPaperList(cmbPrinter)
     
194.     End If
     
195.    
     
196. End Sub
     
197. 
     
198. 完整代碼請參考附件
     

復(fù)制代碼

Henry D. Sy

謝謝分享！

t小寶

精品之作！

wuheng

謝謝分享，先下再學(xué).頂~~~~~``

輕風(fēng)

好東西呀！

風(fēng)中漫步

不錯

todaynew

學(xué)習(xí)一下

tzh16000

太需要了...

咱家是貓

收藏先,以后用得著,謝謝分享.

yanghua1900363

謝謝分享