在ACCESS实现自定义纸张 - Office中国论坛/Access中国论坛

Private Sub CmdNew_Click()
Dim PrinterName As String
Dim FormName As String
Dim FormSize As SIZEL
Dim PrinterHandle As Long
Dim LngWidth As Long
Dim LngHeight As Long
If IsNull(Me.TxtNewStyle) Then
MsgBox "请输入要创建的打印格式"
Me.TxtNewStyle.SetFocus
Exit Sub
End If
If IsNull(Me.TxtWidth) Then
MsgBox "请输入要创建的打印格式的宽度尺寸(mm)"
Me.TxtHeight.SetFocus
Exit Sub
End If
If IsNull(Me.TxtHeight) Then
MsgBox "请输入要创建的打印格式高度尺寸(mm)"
Me.TxtWidth.SetFocus
Exit Sub
End If
If Not IsNumeric(Me.TxtWidth) Then
MsgBox "打印格式宽度尺寸必须是数字类型"
Me.TxtWidth.SetFocus
Exit Sub
End If
If Not IsNumeric(Me.TxtHeight) Then
MsgBox "打印格式高度尺寸必须是数字类型"
Me.TxtWidth.SetFocus
Exit Sub
End If
Dim RetVal As Long
Dim Continue As Long
PrinterName = GetSrvName(cmbPrinter)
FormName = Me.TxtNewStyle
LngWidth = Me.TxtWidth * 1000
LngHeight = Me.TxtHeight * 1000
If PrinterName = "" Then
PrinterName = Printer.DeviceName '当前打印机
Else
MakeDefaultPrinter PrinterName '设置默认打印机
End If
RetVal = AddCustForm(FormName, Me.hwnd, LngWidth, LngHeight, PrinterName)
Select Case RetVal
Case FORM_NOT_SELECTED ' 0
' Selection failed!
MsgBox "添加错误" & " ErrorCode:" & Err.LastDllError, vbExclamation, _
"错误!"
Case FORM_SELECTED ' 1
MsgBox FormName & " 打印格式已经存在于 " & PrinterName & " ", vbExclamation
Case FORM_ADDED ' 2
'//Form added and selected.
MsgBox FormName & " 打印格式已经添加到 " & PrinterName, vbInformation
AddMyForm = True
End Select
ReGetPaperList
End Sub
Private Sub Form_Load()
Dim Prn As Printer
Dim Obj As AccessObject
For Each Prn In Printers
Me.cmbPrinter.AddItem Prn.DeviceName
Next
If cmbPrinter.ListCount > 0 Then
cmbPrinter = Printer.DeviceName
LstPaper.RowSource = GetPaperList(cmbPrinter)
End If
For Each Obj In CurrentProject.AllReports
Me.LstReport.AddItem Obj.Name
Next
End Sub
Private Sub cmbPrinter_AfterUpdate()
Call ReGetPaperList
End Sub
Private Sub CmdDelete_Click()
Dim colNetworkPrinters As New Collection
Dim srvName As String, tmpName As String
Dim FormName As String
Dim PrinterName As String
Dim i
On Error Resume Next
If Me.LstPaper.ListIndex < 0 Then
MsgBox "请选择要删除的纸张格式"
Exit Sub
End If
FormName = Mid(LstPaper, 1, InStr(1, LstPaper, " -") - 1)
tmpName = ""
srvName = GetSrvName(cmbPrinter)
If srvName <> "" Then
Call DeleteMyForm(srvName, FormName)
End If
ReGetPaperList
End Sub
Private Sub CmdReport_Click()
Dim Rpt As Report
' Dim Prt As Report
'Dim accObj As AccessObject
Dim strReportName As String
If Me.LstReport.ListIndex < 0 Then
MsgBox "请选择报表"
Exit Sub
End If
If Me.LstPaper.ListIndex < 0 Then
MsgBox "请选择打印的纸张类型"
Exit Sub
End If
strReportName = LstReport
If IsLoaded(strReportName) Then
MsgBox "不能重复打开相同的报表"
Exit Sub
End If
Select Case strReportName
Case "报表1"
Set Rpt = New Report_报表1
Case "客户标签"
Set Rpt = New Report_客户标签
Case "概览子报表"
Set Rpt = New Report_概览子报表
Case Else
Set Rpt = New Report_报表1
End Select
' Set Rpt = Reports(strReportName)
'Set Rpt = New Report_报表1
With Rpt.Printer
.PaperSize = GetPaperSize(LstPaper)
.Orientation = Me.frameOrientation.Value
End With
clnClient.Add Item:=Rpt, Key:=CStr(Rpt.hwnd)
Rpt.Visible = True
End Sub
Private Sub ReGetPaperList()
'刷新表单(纸张)列表
If Not IsNull(Me.cmbPrinter) Then
LstPaper.RowSource = ""
LstPaper.RowSource = GetPaperList(cmbPrinter)
End If
End Sub
完整代码请参考附件

复制代码