MS Access:自定义纸张尺寸

2023-12-26

我正在构建一个 MS Access (2010) 应用程序,我将从此应用程序打印条形码标签。还有各种其他报告和表格也将使用标准打印机设置进行打印,但是对于条形码,我需要将其打印到特定打印机,并且必须将其设置为使用特殊的页面尺寸。

在我的搜索中我有找到打印机对象的属性 http://msdn.microsoft.com/en-us/library/ff845524“Papersize”本身有很多“标准”默认选项,包括用于 8.5 英寸 x 11 英寸标准美国信函的 acPRPSLetter 和用于 A4 纸张尺寸的 acPRPSA4。所有预设尺寸都不适合我使用。有一个预设代表用户自定义大小 acPRPSUser,但我还没有找到任何方法以编程方式set定制尺寸。

我确实读过有关打印机如何存在“.height”和“.width”属性的信息,但它们似乎并不存在于用于Access 2010的VB中(我相信它是基于VB6的)。

谁能帮我在 Access 2010 中使用 VB 代码设置自定义纸张尺寸?


我有同样的问题。我通过使用解决了它如何:以编程方式检索打印机功能 http://msdn.microsoft.com/EN-US/library/office/ff197339%28v=office.15%29.aspx

我制作了一个带有程序打印输出的模块。通过 Printerselection 函数,我可以使用打印机名称的特定部分来调用打印机。函数 PaperSelection 用于使用纸张名称的特定部分来指定纸张。

首先,我必须使用 DeviceCapability 函数 API 调用的声明

    ' 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

Private Type str_DEVMODE
    RGB As String * 94
End Type

Private Type type_DEVMODE
    strDeviceName As String * 32
    intSpecVersion As Integer
    intDriverVersion As Integer
    intSize As Integer
    intDriverExtra As Integer
    lngFields As Long
    intOrientation As Integer
    intPaperSize As Integer
    intPaperLength As Integer
    intPaperWidth As Integer
    intScale As Integer
    intCopies As Integer
    intDefaultSource As Integer
    intPrintQuality As Integer
    intColor As Integer
    intDuplex As Integer
    intResolution As Integer
    intTTOption As Integer
    intCollate As Integer
    strFormName As String * 32
    lngPad As Long
    lngBits As Long
    lngPW As Long
    lngPH As Long
    lngDFI As Long
    lngDFr As Long
End Type

Private Cnt As Integer, PrinterSelect As Integer

Public Sub PrintOut(ByVal rptName As String, Printer As String, Paper As String, BinName As String, Optional Landscape As Boolean, Optional WhereCond)
Dim rpt As Report
DoCmd.OpenReport rptName, acViewPreview, , WhereCond
Set rpt = Reports(rptName)
PrinterSelect = PrinterSelection(Printer)
rpt.Printer = Application.Printers(PrinterSelect)
rpt.Printer.PaperSize = PaperSelection(Paper, PrinterSelect)
If Landscape Then
    rpt.Printer.Orientation = acPRORLandscape
Else
    rpt.Printer.Orientation = acPRORPortrait
End If
rpt.Printer.PaperBin = BinSelection(BinName, PrinterSelect)
End Sub

Public Function PrinterSelection(Printer As String) As Integer
For Cnt = 0 To Application.Printers.Count - 1
    If InStr(1, Application.Printers(Cnt).DeviceName, Printer) > 0 Then
        PrinterSelection = Cnt
    End If
Next Cnt
End Function

Public Function PaperSelection(Paper As String, Printer As Integer) As Integer

    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 selected printer.
    strDeviceName = Application.Printers(Printer).DeviceName
    strDevicePort = Application.Printers(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.
    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)
        If InStr(1, strPaperName, Paper) > 0 Then
        ' Select the a paper number corresponding to the paper name.
            PaperSelection = aintNumPaper(lngCounter)
        End If
    Next lngCounter


GetPaperList_End:
    Exit Function

GetPaperList_Err:
    MsgBox Prompt:=err.Description, Buttons:=vbCritical & vbOKOnly, _
        Title:="Error Number " & err.Number & " Occurred"
    Resume GetPaperList_End

End Function

Public Function BinSelection(BIN As String, Printer As Integer) As Integer
' Uses the DeviceCapabilities API function to choose the desired paper bin supported by the    chosen printer

    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(Printer).DeviceName
    strDevicePort = Application.Printers(Printer).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)

        If InStr(1, strBinName, BIN) > 0 Then
        ' Select the bin number corresponding to the bin name.
            BinSelection = aintNumBin(lngCounter)
        End If
     Next lngCounter


GetBinList_End:
    Exit Function
GetBinList_Err:
    MsgBox Prompt:=err.Description, Buttons:=vbCritical & vbOKOnly, _
        Title:="Error Number " & err.Number & " Occurred"
    Resume GetBinList_End
End Function
本文内容由网友自发贡献,版权归原作者所有,本站不承担相应法律责任。如您发现有涉嫌抄袭侵权的内容,请联系:hwhale#tublm.com(使用前将#替换为@)

MS Access:自定义纸张尺寸 的相关文章

  • Excel VBA 通过简单除法引发溢出错误

    Excel 2013 VBA 这段代码 Sub test On Error GoTo Err Dim p As Double p 362 100 2005 Exit Sub Err If Err Description lt gt And
  • Excel VBA 将范围值复制到数组,

    我有以下代码摘录 我试图将一系列值复制到声明的数组上 但它一直给我 无法分配给数组 错误 Dim permittedCurve 0 To 7000 As Variant permittedCurve activeWorkbook Works
  • 如何循环浏览文件夹内所有工作簿中的所有工作表

    我使用宏对计算机上给定文件夹中每个工作簿的每张工作表进行更改 事件顺序 打开用户选择的文件夹中的每个 Excel 文件 在工作簿中的每个工作表上执行任务 保存文件 关闭工作簿 宏不起作用 问题似乎是由Selection AutoFilter
  • 请参阅使用代号的表

    我在此代码中收到 类型不匹配 错误 With Worksheets Sheet1 Error here my code here End With 我的床单CodeName is sheet1 有人可以帮我消除错误吗 1 按索引参阅表 Wi
  • 将参数传递给使用“New”创建的访问表单

    我有一个名为 详细信息 的表单 它显示所选记录的详细视图 该记录是从称为 搜索 的不同形式中选择的 因为我希望能够打开 详细信息 的多个实例 每个实例显示不同记录的详细信息 所以我使用了以下代码 Public detailCollectio
  • 将范围传递给 Excel 用户定义函数并将其分配给数组

    我在尝试着 通过两个范围 多行单列 Excel 2007 中的用户定义函数 然后将其分配给一个数组进行处理 谁能告诉我如何将这样的范围分配给数组 范围不是恒定的 因为我在不同的单元格中使用 UDF 来处理不同的数据 所以我不能使用 e g
  • 副水平X轴VBA最大刻度

    通过以下代码和敏 正在设置 VBA 中图表的主水平 X 轴的比例 Sub chart set Dim objCht As ChartObject With ActiveSheet ChartObjects 1 Chart Axes xlVa
  • 使用 access VBA 将列表框项目添加到数组

    我在访问表单中有一个列表框 它包含 18 项 我如何使用 access vba 将这些项目存储到数组中 下面将把列表框的内容拉入数组并吐出内容 Dim Size As Integer Size Me List0 ListCount 1 Re
  • 访问应用程序,带有表单任务栏图标的隐藏应用程序窗口

    我有一个带有一个主表单的访问应用程序 当您打开应用程序时 AutoExec 宏会通过 Windows API apiShowWindow 隐藏应用程序 然后 AutoExec 打开设置为 Popup 的主窗体 这一切都很顺利 我的数据库内容
  • 使用 VBA 将 Excel 中的范围粘贴到 Powerpoint 模板的特定幻灯片中

    我花了好几个小时查看针对我的问题的各种建议解决方案 但找不到任何似乎可以完成工作的东西 或者更可能的是 我对 VBA 的掌握正在了解我理解在线解决方案的能力 因此 我希望你们中的一位好心人能够帮助我解决问题 我打开了一个 Excel 工作表
  • 如何在服务器(无 GUI)上呈现网页以进行打印?

    我正在尝试使用 PHP 脚本将页面实用地打印到办公室打印机 这是我到目前为止所得到的 我在服务器上安装了一台打印机 我可以通过命令行的打印命令使用 PHP 向其发送作业 我还可以使用 PHP 脚本编写纯文本文件 然后将它们添加到打印提示中
  • Access 2007 不会从 XML 文件导入所有元素数据

    我需要将此 XML 数据导入 Access 中以进行进一步处理 我在这里只复制了一小部分数据
  • 升级到 Office 365 专业增强版后 Excel VBA 运行速度极慢

    我粘贴部分代码如下 这段代码是解析从HTTP请求得到的JSON字符串 根本没有工作表 工作簿操作 在office升级到office365专业增强版之前 效率还是蛮高的 但升级后 解析一个不到2秒的json 却要花费几分钟 我个人不明白根本原
  • Access 2007 数据库和应用程序的版本控制

    我需要对 Microsoft Access 2007 数据库和应用程序进行版本控制 目前 所有内容都包含在单个 mdb 文件中 该应用程序包括 Forms VBA code 实际数据库 我假设我需要将数据库与表单 代码分开 我希望能够将表单
  • VBA填写两个单元格之间的所有单元格

    我目前正在尝试编写一些 VBA 代码 该代码将使用两个单元格的值填充两个单元格之间的所有单元格 这是我所拥有的 我希望代码能够填写之间的所有单元格 如下所示 因此 正如您所看到的 我希望中间的所有单元格都填写为与两个角单元格相同的值 很感谢
  • 运行时错误“1004”:工作表类的粘贴方法失败错误

    使用 VBA 将 1 行文本从 Word 复制粘贴到 Excel 当代码到达下面的行时 我收到以下错误 ActiveSheet Paste 运行时错误 1004 工作表类的粘贴方法失败错误 But 如果我单击 调试 按钮并按 F8 则会粘贴
  • 使用 VBA 从 Word 发送 HTTP 请求

    我正在尝试将数据从 Word 文档发送到网页 我找到了一些代码 将其粘贴到新模块中并保存 当我运行它时 我收到 编译错误 用户定义的类型未定义 My code Sub http Dim MyRequest As New WinHttpReq
  • 在vba中打乱数组[重复]

    这个问题在这里已经有答案了 我需要对数组中的值进行无重复的洗牌 我需要在代码中添加什么以避免重复 Function Resample data vector n UBound data vector ReDim shuffled vecto
  • 在 Excel 中用 VBA 替换 Chr(160) 时遇到问题

    我收到 Excel 文件已有一段时间了 这些文件通常在帐户后面受特殊字符 alt 0160 的困扰 我通常只是在 Excel 中手动替换它 但最近我变得懒惰了 想使用我的 VBA 脚本替换它 该脚本用于将所需的列插入到我们的数据库中 Sub
  • VBA getelementsbytagname问题

    早上好 我正在尝试提取 HTML 表信息并在 Excel 电子表格上整理结果 我正在使用getelementsbytagname table 0 函数来提取 HTML 表格信息 效果很好 有人可以告诉我这有什么意义吗 0 桌子之后 另外 我

随机推荐

  • 使用 Cython 生成的可执行文件真的没有源代码吗?

    我读过了在 Cython 中制作可执行文件 https stackoverflow com questions 22507592 making an executable in cython和 BuvinJ 的回答如何有效混淆Python代
  • 以编程方式选择 Kendo 网格行

    我找到了类似标题的帖子 但仍然无法解决我的问题 我肯定做错了什么 在 Kendo 网格配置中 有一些函数可以获取上下文 网格 并读取所选行 change function e refresh this 这就是我配置 更改 事件的方式 在函数
  • Pygame.movi​​e 丢失[重复]

    这个问题在这里已经有答案了 我目前正在使用 RPi 3B 最新的 Raspbian Jessie 进行一个小项目 其中涉及播放短的 mp4 文件 由于 Pygame 似乎支持播放 mpg 文件 因此我将视频转换为该格式 然而 当我尝试导入电
  • 代码合同 - Visual Studio Team Service 脚本化构建服务器单元测试失败

    我最近将代码契约添加到我的解决方案中 经过一些修改后 我们的构建运行没有任何问题 但我们的单元测试由于代码契约而失败 环境 源代码控制和构建服务器托管在Visual Studio 团队服务 https www visualstudio co
  • 从 Tinymce 获取 HTML 值

    有没有办法使用 jQuery 从 TinyMCE 编辑器获取 HTML 内容 以便我可以将其复制到另一个 div 我在内容上尝试了几种方法 例如 val 但它似乎不起作用 如果您正在使用 jquery 适配器进行初始化 selector t
  • Codeigniter 图片上传只会上传到一个目录

    function upload path config overwrite TRUE config allowed types jpg jpeg gif png config max size 2000 if path profile co
  • EJB 3.1 异步方法和线程池

    我每天需要使用 EJB 3 1 异步方法处理大约 250 000 个文档 才能应对整体的长时间任务 我这样做是为了使用更多线程并同时处理更多文档 这是伪代码的示例 this returns about 250 000 documents p
  • 如何在opencpu中链接两个函数调用

    据说 OpenCPU 支持链接函数调用来计算 例如f g x h y 有关参数格式的文档 https public opencpu org api html api arguments https public opencpu org ap
  • Web 开发人员 - 在本地计算机上还是在远程主机上进行开发更好?

    在本地计算机上而不是在集中式开发服务器上进行 Web 开发有哪些优点 缺点 对于那些在本地计算机上进行开发的人来说 当涉及多个开发人员时 如何为本地开发保留更新的数据库架构 特别是 我目前正在试验适用于 PHP 的 XAMPP 并且很好奇当
  • 有问题的 System.Diagnostics.Contracts 的有用性

    我一直在使用新的 System Diagnostics Contracts 类 因为它一开始看起来非常有用 用于检查入站参数 返回值等的静态方法 它是一个干净的接口 可以替换大量 if then 语句和内部构建的库工具 然而 它在大多数运行
  • docker SHM_SIZE /dev/shm:调整共享内存大小

    我想调整大小postgres容器默认的共享内存64M 所以我补充一下 build context shm size 2gb 我正在使用 3 6 版本的 compose 文件 postgres服务定义 version 3 6 services
  • Prolog 中的“逻辑纯度”是什么意思?

    逻辑纯度 是什么意思 在 Prolog 编程的上下文中 这逻辑纯粹性 questions tagged logical purity标签信息说 仅使用 Horn 子句的程序 但是那么 谓词会如何if 3 https stackoverflo
  • 无法导入 org.h2.server.web.WebServlet

    我正在尝试配置我的 Spring Boot 应用程序以使用 h2 控制台 我找了一些文章 都是使用webServlet 但我无法导入该类 尽管我在 pom xml 中添加了 h2 依赖项 我收到此错误消息can not resolve th
  • 取消接受并关闭 Python 处理/多处理侦听器连接的正确方法

    我正在使用py处理 http developer berlios de projects pyprocessing在此示例中的模块 但是如果您运行 则用多处理替换处理可能应该可以工作蟒蛇2 6 http docs python org li
  • MySQL - 实体:表“TableDetails”中列“IsPrimaryKey”的值为 DBNull

    我在用视觉工作室2013 with 实体框架5 and Mmysql服务器5 7 9 当尝试从数据库创建模型时 或 从数据库更新模型 将出现以下消息 System Data StrongTypingException 列的值 表 Table
  • 使用 URL 打开 Chrome 应用

    有没有办法从默认的 Android 浏览器打开 Android 上的 Chrome 应用程序 我可以打开该应用程序 但它不会将用户重定向到正确的页面 这是我尝试过的 a href 我发现我可能必须形成一个意图 URL 但我希望有一种比这更简
  • “Web”客户端类型不允许自定义方案 URI - Google 与 Firebase

    我正在尝试使用 firebase 在我的 iOS 应用程序中实现 google 登录 我遵循这个教程 https firebase google com docs auth ios google signin https firebase
  • 在 FileAppender 中使用 Logback 标记时出错

    我已经开始探索我们的应用程序的 Logback 选项 要求之一是为具有特定 标记 的日志条目创建单独的日志文件 下面是我正在使用的 logback xml 文件和我收到的错误 logback 网站上的示例显示了 SMTPAppender 的
  • 需要帮助实施 Facebook 积分

    我读过一些关于开始实施 Facebook 积分的其他帖子 并且从 github 下载了示例代码 https github com facebook credits api sample https github com facebook c
  • MS Access:自定义纸张尺寸

    我正在构建一个 MS Access 2010 应用程序 我将从此应用程序打印条形码标签 还有各种其他报告和表格也将使用标准打印机设置进行打印 但是对于条形码 我需要将其打印到特定打印机 并且必须将其设置为使用特殊的页面尺寸 在我的搜索中我有