excel VBAで、プリンターの印刷余白及び用紙サイズを取得するには

質問

Excelでラベル印刷を行っています。
社内には多種類のプリンターがあり、それぞれで印刷可能位置が違うため、中には最後の行が半分しか印刷できないようなプリンターもあります。
そのようなプリンターに関しては、印刷行数を１行減らすよう設定したいと思っています。　そこでプリンターが持っている印刷可能位置（上下・左右余白等）を取り込みたいのですがその方法が分かりません。　どなたかご教示お願いします。

回答No.2

kurinkurinkurin · ベストアンサー

Declare Function CreateDC Lib "gdi32.dll" Alias "CreateDCA" _
(ByVal lpszDrive As String, ByVal lpszDevice As String, _
ByVal lpszOutput As Long, lpInitData As DEVMODE) As Long

Declare Function GetDeviceCaps Lib "gdi32" ( _
ByVal hdc As Long, _
ByVal nIndex As Long _
) As Long

Declare Function DeleteDC Lib "gdi32" (ByVal hdc As Long) As Long

Private Const HORZRES = 8 '実際のスクリーンの幅（実印刷領域）
Private Const VERTRES = 10 '実際のスクリーンの高さ
Private Const PHYSICALWIDTH = 110 '物理的幅(実用紙サイズ）
Private Const PHYSICALHEIGHT = 111 '物理的高さ
Private Const PHYSICALOFFSETX = 112 '印刷可能な左方向のマージン
Private Const PHYSICALOFFSETY = 113 '印刷可能な上方向のマージン

Public Const CCHDEVICENAME = 32
Public Const CCHFORMNAME = 32

Public Type DEVMODE
dmDeviceName As String * CCHDEVICENAME
dmSpecVersion As Integer
dmDriverVersion As Integer
dmSize As Integer
dmDriverExtra As Integer
dmFields As Long
dmOrientation As Integer
dmPaperSize As Integer
dmPaperLength As Integer
dmPaperWidth As Integer
dmScale As Integer
dmCopies As Integer
dmDefaultSource As Integer
dmPrintQuality As Integer
dmColor As Integer
dmDuplex As Integer
dmYResolution As Integer
dmTTOption As Integer
dmCollate As Integer
dmFormName As String * CCHFORMNAME
dmUnusedPadding As Integer
dmBitsPerPel As Long
dmPelsWidth As Long
dmPelsHeight As Long
dmDisplayFlags As Long
dmDisplayFrequency As Long
End Type

Const LOGPIXELSX = 88
Const LOGPIXELSY = 90

Sub test()

'http://hpcgi1.nifty.com/MADIA/VBBBS/wwwlng.cgi?print+200505/05050096.txt より
'アクティブプリンターの取得
Dim ret As Long
Dim lngPrinter As Long
Dim ActivePrinterName As String
Dim devm As DEVMODE
Dim intPos As Integer

devm.dmSize = LenB(devm)

intPos = InStr(1, Application.ActivePrinter, " on ")
If intPos > 0 Then
ActivePrinterName = Mid$(Application.ActivePrinter, 1, intPos - 1)
End If

If intPos = 0 Then
intPos = InStr(1, Application.ActivePrinter, " の ")
If intPos > 0 Then
ActivePrinterName = Mid$(Application.ActivePrinter, intPos + 3)
Else
MsgBox ("ありえない")
Exit Sub
End If
End If

lngPrinter = CreateDC("WINSPOOL", ActivePrinterName, 0, devm)

'http://www.bcap.co.jp/hanafusa/VBHLP/pMargi.n.htmより
'プリンターの印刷余白を取得

Dim LeftMargin As Long, TopMargin As Long
Dim RightMargin As Long, BottomMargin As Long
Dim PhysHeight As Long, PhysWidth As Long
'マージンをピクセル単位で取得しそれをmmに変換
LeftMargin = ScaleX(lngPrinter, GetDeviceCaps(lngPrinter, PHYSICALOFFSETX))
TopMargin = ScaleY(lngPrinter, GetDeviceCaps(lngPrinter, PHYSICALOFFSETY))
PhysWidth = ScaleX(lngPrinter, GetDeviceCaps(lngPrinter, PHYSICALWIDTH))
PhysHeight = ScaleY(lngPrinter, GetDeviceCaps(lngPrinter, PHYSICALHEIGHT))
'用紙サイズから印刷可能領域を差引きマージンを求める
RightMargin = PhysWidth - (ScaleX(lngPrinter, GetDeviceCaps(lngPrinter, HORZRES)))
BottomMargin = PhysHeight - (ScaleY(lngPrinter, GetDeviceCaps(lngPrinter, VERTRES)))
Debug.Print "プリンター用紙印刷余白(左)　： " & LeftMargin & " mm"
Debug.Print "プリンター用紙印刷余白(上)　： " & TopMargin & " mm"
Debug.Print "プリンター用紙印刷余白(右)　： " & RightMargin & " mm"
Debug.Print "プリンター用紙印刷余白(下)　： " & BottomMargin & " mm"
Debug.Print "プリンター用紙サイズ(幅)　 ： " & PhysWidth & " mm"
Debug.Print "プリンター用紙サイズ(高さ)　： " & PhysHeight & " mm"

ret = DeleteDC(lnghPrinter)

End Sub

'http://www.kit.hi-ho.ne.jp/h-suenaga/progtips.html#bcb1 より ピクセル->mmの計算式
'1インチ = 25.4mm
Function ScaleX(ByVal lngPrinter As Long, ByVal Value As Long)
ScaleX = Int(0.5 + 25.4 * Value / GetDeviceCaps(lngPrinter, LOGPIXELSX))
End Function
Function ScaleY(ByVal lngPrinter As Long, ByVal Value As Long)
ScaleY = Int(0.5 + 25.4 * Value / GetDeviceCaps(lngPrinter, LOGPIXELSY))
End Function

お礼

kurinkurinkurin さん ありがとうございました。　まだTEST段階ですが何とかなりそうです。詳しい説明本当にありがとうございました。

回答No.1

HERO TKS（@HERO_TKS）

私ならプリントアウトするプリンターを決めVBの中にactiveprinterを取得するように組むけどなぁ

補足

ありがとうございます。初心者なのでよく分かりませんが、「activeprinterを取得…」はExcel VBAでもできるのですか？またどのように組めばよいのでしょう？