![](http://oshiete.xgoo.jp/images/v2/pc/qa/question_title.png?5a7ff87)
No.2ベストアンサー
- 回答日時:
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
この回答へのお礼
お礼日時:2007/05/25 00:54
kurinkurinkurin さん ありがとうございました。 まだTEST段階ですが何とかなりそうです。詳しい説明本当にありがとうございました。
お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!
似たような質問が見つかりました
- プリンタ・スキャナー 封筒印刷 差出人印刷ずれる 4 2022/05/01 10:12
- その他(Microsoft Office) Excelのマクロについて教えてください。 1 2022/03/25 10:03
- プリンタ・スキャナー Wordで作った宛名ラベルを印刷しようと思って、プリンターの上のところにある、手差しトレイ的なところ 3 2022/11/17 18:40
- プリンタ・スキャナー RICOHオンデマンドで、手差しで中綴じ印刷をしたいです。 (A4の内容を用紙サイズA3で印刷したい 1 2022/10/14 14:29
- Excel(エクセル) 【Excel】複数シートがあるエクセルデータで片面印刷と両面印刷設定がシートごとに入 1 2023/03/10 15:25
- ノートパソコン Windows11homeを新しく購入し、初期設定をしています。 前のパソコンでは無線のFAX機や有 5 2023/04/18 19:50
- プリンタ・スキャナー 2台のプリンターでそれぞれ異なる様式の帳票を印刷したい。 2 2022/09/06 10:07
- 事務・総務 郵便払込取扱票への記入揺れ 1 2022/03/26 22:54
- Android(アンドロイド) プリンターが見つかりません 4 2023/05/05 16:54
- プリンタ・スキャナー 印刷ができない 6 2022/04/01 20:47
このQ&Aを見た人はこんなQ&Aも見ています
関連するカテゴリからQ&Aを探す
このQ&Aを見た人がよく見るQ&A
デイリーランキングこのカテゴリの人気デイリーQ&Aランキング
-
Word プレビューと実際の印刷が...
-
ドコモメールをプリンターで印...
-
ワードに貼り付けた図の印刷バ...
-
PCLとPSプリンタドライバーどっ...
-
削除済みのプリンターの印刷ジ...
-
自宅から会社のプリンターで印...
-
緊急です アイビスペイントで絵...
-
ネットカフェでは、持ちこんだP...
-
スマホ画面を印刷するには
-
印刷ができない
-
印刷できません
-
DVDのレーベル面に印刷をしたい...
-
オートシェイプが一部印刷され...
-
インデックスに印字する方法を...
-
Windows11でプリントできません
-
印刷削除中のまま動きません
-
ページ数多いPDFを印刷しようと...
-
エクセルで表の枠しか印刷出来...
-
B4プリンター
-
1ページしか印刷しないのですが
マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング
-
ドコモメールをプリンターで印...
-
PCLとPSプリンタドライバーどっ...
-
スマホから自宅印刷 スマホから...
-
【Microsoft Office Excel Comp...
-
自宅から会社のプリンターで印...
-
Word プレビューと実際の印刷が...
-
1ページしか印刷しないのですが
-
プリンターの印刷待ちの解除方...
-
ワードに貼り付けた図の印刷バ...
-
削除済みのプリンターの印刷ジ...
-
エクセルの罫線が印刷できない
-
【EXCEL2013】条件付書式で文字...
-
印刷ができない
-
スマホ画面を印刷するには
-
Windows11でプリントできません
-
A4プリンターで2枚に分けてのA...
-
ネットカフェでは、持ちこんだP...
-
Word2013 途中のページから印...
-
印刷時一枚目が白紙で排出
-
パソコンとプリンターをUSBケー...
おすすめ情報