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

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

No.2 ベストアンサー 回答者： kurinkurinkurin 回答日時： 2007/05/24 17:19

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?p … より
'アクティブプリンターの取得
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.ht … より ピクセル->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段階ですが何とかなりそうです。詳しい説明本当にありがとうございました。

お礼日時：2007/05/25 00:54

No.1 回答者： HERO_TKS 回答日時： 2007/05/23 21:13

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

この回答への補足

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

補足日時：2007/05/23 22:33