设为首页收藏本站Access中国

Office中国论坛/Access中国论坛

 找回密码
 注册

QQ登录

只需一步,快速开始

返回列表 发新帖
查看: 15585|回复: 33
打印 上一主题 下一主题

[Access本身] 在ACCESS实现自定义纸张

[复制链接]
跳转到指定楼层
1#
发表于 2011-10-9 11:02:59 | 显示全部楼层 回帖奖励 |倒序浏览 |阅读模式
在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 "请输入要创建的打印格式"
  11.        Me.TxtNewStyle.SetFocus
  12.        Exit Sub
  13.     End If
  14.    
  15.     If IsNull(Me.TxtWidth) Then
  16.        MsgBox "请输入要创建的打印格式的宽度尺寸(mm)"
  17.        Me.TxtHeight.SetFocus
  18.        Exit Sub
  19.     End If
  20.    
  21.     If IsNull(Me.TxtHeight) Then
  22.        MsgBox "请输入要创建的打印格式高度尺寸(mm)"
  23.        Me.TxtWidth.SetFocus
  24.        Exit Sub
  25.     End If
  26.    
  27.     If Not IsNumeric(Me.TxtWidth) Then
  28.        MsgBox "打印格式宽度尺寸必须是数字类型"
  29.        Me.TxtWidth.SetFocus
  30.        Exit Sub
  31.     End If
  32.    
  33.     If Not IsNumeric(Me.TxtHeight) Then
  34.        MsgBox "打印格式高度尺寸必须是数字类型"
  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     '当前打印机
  51.     Else
  52.         MakeDefaultPrinter PrinterName       '设置默认打印机
  53.     End If

  54.     RetVal = AddCustForm(FormName, Me.hwnd, LngWidth, LngHeight, PrinterName)

  55.     Select Case RetVal
  56.         Case FORM_NOT_SELECTED    ' 0
  57.             ' Selection failed!
  58.             MsgBox "添加错误" & " ErrorCode:" & Err.LastDllError, vbExclamation, _
  59.                     "错误!"
  60.         Case FORM_SELECTED   ' 1
  61.            MsgBox FormName & " 打印格式已经存在于 " & PrinterName & " ", vbExclamation
  62.         Case FORM_ADDED      ' 2
  63.             '//Form added and selected.
  64.             MsgBox FormName & " 打印格式已经添加到 " & PrinterName, vbInformation
  65.             AddMyForm = True
  66.    End Select
  67.    
  68.   ReGetPaperList
  69.    
  70. End Sub

  71. Private Sub Form_Load()
  72.     Dim Prn As Printer
  73.     Dim Obj As AccessObject
  74.    
  75.     For Each Prn In Printers
  76.         Me.cmbPrinter.AddItem Prn.DeviceName
  77.     Next
  78.    
  79.     If cmbPrinter.ListCount > 0 Then
  80.        cmbPrinter = Printer.DeviceName
  81.        LstPaper.RowSource = GetPaperList(cmbPrinter)
  82.     End If
  83.    
  84.    For Each Obj In CurrentProject.AllReports
  85.       Me.LstReport.AddItem Obj.Name
  86.    Next
  87. End Sub


  88. Private Sub cmbPrinter_AfterUpdate()
  89.     Call ReGetPaperList
  90. End Sub

  91. Private Sub CmdDelete_Click()
  92.     Dim colNetworkPrinters As New Collection
  93.     Dim srvName As String, tmpName As String

  94.     Dim FormName As String
  95.     Dim PrinterName As String
  96.     Dim i

  97.     On Error Resume Next

  98.     If Me.LstPaper.ListIndex < 0 Then
  99.         MsgBox "请选择要删除的纸张格式"
  100.         Exit Sub
  101.     End If
  102.     FormName = Mid(LstPaper, 1, InStr(1, LstPaper, " -") - 1)
  103.    
  104.     tmpName = ""
  105.     srvName = GetSrvName(cmbPrinter)
  106.    
  107.     If srvName <> "" Then
  108.     Call DeleteMyForm(srvName, FormName)
  109.      End If
  110.      
  111.    
  112.     ReGetPaperList
  113. End Sub

  114. Private Sub CmdReport_Click()
  115.     Dim Rpt As Report
  116.    ' Dim Prt As Report
  117.     'Dim accObj As AccessObject
  118.    
  119.     Dim strReportName As String
  120.    
  121.     If Me.LstReport.ListIndex < 0 Then
  122.        MsgBox "请选择报表"
  123.        Exit Sub
  124.     End If
  125.    
  126.    
  127.     If Me.LstPaper.ListIndex < 0 Then
  128.        MsgBox "请选择打印的纸张类型"
  129.        Exit Sub
  130.     End If
  131.    
  132.     strReportName = LstReport
  133.    
  134.     If IsLoaded(strReportName) Then
  135.        MsgBox "不能重复打开相同的报表"
  136.        Exit Sub
  137.     End If
  138.    
  139.    
  140.     Select Case strReportName
  141.    
  142.       Case "报表1"
  143.    
  144.          Set Rpt = New Report_报表1
  145.    
  146.       Case "客户标签"
  147.    
  148.          Set Rpt = New Report_客户标签
  149.          
  150.       Case "概览子报表"
  151.         
  152.          Set Rpt = New Report_概览子报表
  153.         
  154.       Case Else
  155.       
  156.        Set Rpt = New Report_报表1
  157.       
  158.     End Select
  159.    
  160.    
  161.    
  162.    
  163.    ' Set Rpt = Reports(strReportName)
  164.    

  165. 'Set Rpt = New Report_报表1
  166.     With Rpt.Printer
  167.       
  168.         .PaperSize = GetPaperSize(LstPaper)
  169.         .Orientation = Me.frameOrientation.Value
  170.         
  171.     End With

  172.     clnClient.Add Item:=Rpt, Key:=CStr(Rpt.hwnd)
  173.     Rpt.Visible = True
  174. End Sub


  175. Private Sub ReGetPaperList()
  176. '刷新表单(纸张)列表
  177.     If Not IsNull(Me.cmbPrinter) Then
  178.        LstPaper.RowSource = ""
  179.        LstPaper.RowSource = GetPaperList(cmbPrinter)
  180.     End If
  181.    
  182. End Sub

  183. 完整代码请参考附件
复制代码

本帖子中包含更多资源

您需要 登录 才可以下载或查看,没有帐号?注册

x

评分

参与人数 2经验 +15 收起 理由
purplerose + 5
todaynew + 10 很给力!

查看全部评分

分享到:  QQ好友和群QQ好友和群 QQ空间QQ空间 腾讯微博腾讯微博 腾讯朋友腾讯朋友
收藏收藏5 分享分享 分享淘帖 订阅订阅
2#
 楼主| 发表于 2011-10-9 20:42:34 | 显示全部楼层
小宝的是什么系统,麻烦换其他驱动测试
2010 和 2003 环境下都没有你说的问题
您需要登录后才可以回帖 登录 | 注册

本版积分规则

QQ|站长邮箱|小黑屋|手机版|Office中国/Access中国 ( 粤ICP备10043721号-1 )  

GMT+8, 2024-11-1 07:22 , Processed in 0.087945 second(s), 29 queries .

Powered by Discuz! X3.3

© 2001-2017 Comsenz Inc.

快速回复 返回顶部 返回列表