0
0

Delete article

Deleted articles cannot be recovered.

Draft of this article would be also deleted.

Are you sure you want to delete this article?

More than 3 years have passed since last update.

今更ながらAccessVBAで用紙名称からPaperSizeに設定すべき数値を取得する方法

Posted at

#VBAで用紙を指定する定数が環境ごとに異なることを初めて知った
VBAで用紙を指定するにはPaperSizeプロパティに数値を打ち込むのですが、
ある程度決まったサイズは定数として切ってあります。

が、ユーザー定義用紙や連票など、ドライバにより異なる用紙サイズは定数に存在せず、
環境ごとに異なる数字になることを、大人になって数十年経過して初めて知りました。

ある環境のPCで設定したaccdbファイルを違うPCに持っていって印刷してみるとLetterになって印刷されてしまい、
PCごとにページ設定を行ってあげないと狙った用紙で出力されないなんてことでハマった方は多いんじゃないでしょうか。

結果、ぐぐったら
http://locosoft.cocolog-nifty.com/blog/2012/03/excel-vba-820b.html
こちらのブログで名もなきエンジニアの方がWordのVBAにてWin32APIを使用して用紙名称から用紙番号を取得する方法を公開していらっしゃいましたので、このたび少しだけ汎化したものを、ここに残しておこうと思います。
お礼は↑のブログのコメント欄へどうぞ。

Option Compare Database
Option Explicit

'各種宣言(ほぼ丸コピ)
Private Declare Function OpenPrinter Lib "winspool.drv" Alias "OpenPrinterA" (ByVal pPrinterName As String, phPrinter As Long, ByVal pDefault As Long) As Long
Private Declare Function ClosePrinter Lib "winspool.drv" (ByVal hPrinter As Long) As Long
Private Declare Function DeviceCapabilities Lib "winspool.drv" Alias "DeviceCapabilitiesA" (ByVal pDevice As String, ByVal pPort As String, ByVal fwCapability As Long, pOutput As Any, pDevMode As Any) As Long
Private Declare Sub MoveMemory Lib "kernel32.dll" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
Private Const DC_PAPERNAMES = 16
Private Const DC_PAPERS = 2

'主関数(帳票をプレビューして用紙を設定して印刷する)
Function FuncMain() As Boolean
    DoCmd.OpenReport "DENPYOU", acViewPreview
    Reports("DENPYOU").Printer.PaperSize = GetPaperName2PaperSize("DENPYOU02", "連続紙 15x5inch")
    DoCmd.PrintOut
End Function

'プリンタ名称と用紙名称から、PaperSizeに該当する値を取得する関数(ほぼ丸コピ)
Public Function GetPaperName2PaperSize(printerName As String, paraPaperName As String) As Integer
    Dim lPaperCount As Long
    Dim lCounter As Long
    Dim hPrinter As Long
    Dim sDeviceName As String
    Dim sDevicePort As String
    Dim bytPaper() As Byte
    Dim strPaperName As String * 64
    Dim aintNubytPaper() As Integer
    Dim onePaperName As String
   
    GetPaperName2PaperSize = -1
    sDeviceName = printerName
   
    If OpenPrinter(sDeviceName, hPrinter, 0) <> 0 Then

        ' バッファに必要なサイズ(用紙数)を取得
        lPaperCount = DeviceCapabilities(sDeviceName, sDevicePort, DC_PAPERNAMES, ByVal vbNullString, 0)
        ReDim bytPaper(64 - 1, lPaperCount - 1)
        ReDim aintNubytPaper(1 To lPaperCount)
       
        '用紙名を取得
        Call DeviceCapabilities(sDeviceName, sDevicePort, DC_PAPERNAMES, bytPaper(0, 0), 0)
        '用紙番号を取得
        Call DeviceCapabilities(sDeviceName, sDevicePort, DC_PAPERS, aintNubytPaper(1), ByVal vbNullString)
        For lCounter = 0 To lPaperCount - 1
            ' 用紙名コピー
            MoveMemory ByVal strPaperName, bytPaper(0, lCounter), 64
            ' 用紙名追加
            onePaperName = Left(strPaperName, InStr(strPaperName, vbNullChar) - 1)
            ' 指定の用紙名が入っていたらその用紙番号を返す
            If InStr(LCase(onePaperName), LCase(paraPaperName)) > 0 Then
                GetPaperName2PaperSize = aintNubytPaper(lCounter + 1)
                Exit For
            End If
        Next lCounter
       
        ClosePrinter (hPrinter)
    End If
End Function
0
0
0

Register as a new user and use Qiita more conveniently

  1. You get articles that match your needs
  2. You can efficiently read back useful information
  3. You can use dark theme
What you can do with signing up
0
0

Delete article

Deleted articles cannot be recovered.

Draft of this article would be also deleted.

Are you sure you want to delete this article?