No.2ベストアンサー
- 回答日時:
こんにちは。
KenKen_SP です。下記コードをそれぞれの場所にコピー&ペーストして下さい。
ご希望どおり動くと思いますが、テストする時間がなかったので、
いきなり重要なファイルでは試さなさないで下さい。
'◆場所:ThisWorkbook ------------------------------------------------
Option Explicit
'印刷クオリティー調整
Private Sub Workbook_BeforePrint(Cancel As Boolean)
Dim sPrinter As String
Dim lResmode As Long
On Error GoTo ErrorHandler
'アクティブプリンタ名取得
sPrinter = GetActivePrinter()
If sPrinter <> vbNullString Then
'アクティブプリンタの最高解像度取得
lResmode = GetHighResMode(sPrinter)
End If
'解像度が取得できたときのみ変更
If lResmode <> 0 Then
ActiveSheet.PageSetup.PrintQuality = lResmode
End If
Exit Sub
ErrorHandler:
End Sub
'----------------------------------------ここまで ThisWorkbook--------
'◆場所:標準モジュール ----------------------------------------------
Option Explicit
'プリンタデバイスドライバの能力を取得する
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
'fwCapability定数
Private Const DC_ENUMRESOLUTONS = 13 '使用可能な解像度リスト
'プリンタの最高印刷解像度を取得
Public Function GetHighResMode(strPrinterName) As Long
Dim lngApiResultCode As Long
Dim lngResMode() As Long
'関数初期化
GetHighResMode = 0
'使用可能な解像度モード数(Long)*2 = バッファサイズ
lngApiResultCode = _
DeviceCapabilities( _
strPrinterName, vbNullString, _
DC_ENUMRESOLUTONS, _
ByVal vbNullString, _
ByVal vbNullString _
)
If lngApiResultCode <> 0 Then
'解像度取得
ReDim lngResMode(lngApiResultCode * 2 - 1)
lngApiResultCode = _
DeviceCapabilities( _
strPrinterName, _
vbNullString, _
DC_ENUMRESOLUTONS, _
lngResMode(0), _
ByVal vbNullString _
)
If lngApiResultCode <> 0 Then
'最高解像度を返す
GetHighResMode = Application _
.WorksheetFunction.Max(lngResMode)
End If
End If
End Function
'アクティブプリンタ名を返す(不要文字カット)
Public Function GetActivePrinter() As String
Dim sPrinterName As String
Dim iSplitPos As Integer
GetActivePrinter = vbNullString
sPrinterName = Application.ActivePrinter
iSplitPos = InStr(1, sPrinterName, " on")
If iSplitPos > 0 Then
GetActivePrinter = Left$(sPrinterName, iSplitPos - 1)
Else
iSplitPos = InStr(1, sPrinterName, "の")
If iSplitPos > 0 Then
GetActivePrinter = Mid$(sPrinterName, iSplitPos + 2)
End If
End If
End Function
'--------------------------------------ここまで 標準モジュール--------
うっひゃぁ~!
ほんとに大掛かりなコードですねえ!
こうなると、もう何がなんだかわかりませんが、何度もありがとうございました。
このままコピペしてためしたら、ばっちりOKでした。
No.1
- 回答日時:
こんにちは。
KenKen_SP です。> そのプリンターの最高画質で印刷させるためにはVBAをどんなふう
> に記述すればいいでしょうか?
Win32 API の DocumentProperties あたりを使うと可能ですが、複雑
で大掛かりなコードになります。プリンタ制御って結構難しい部類で
すね。技術資料が少ないのです。
On Error ステートメントで逃げるのはダメですか?
下記のコードは、ThisWorkbook に貼り付けて下さい。
'印刷クオリティー調整(場所:ThisWorkbook)
Private Sub Workbook_BeforePrint(Cancel As Boolean)
On Error Resume Next
ActiveSheet.PageSetup.PrintQuality = 1200
'実行時エラーが発生した場合
If Err.Number > 0 Then
ActiveSheet.PageSetup.PrintQuality = 600
End If
On Error GoTo 0
End Sub
KenKen_SPさん、いつもお世話様です。
プリンタ制御って大変なんですね。
そんな大掛かりなコードになるなら、上記のやりかたで十分です。
ありがとうございました。
お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!
似たような質問が見つかりました
- その他(Microsoft Office) Excelのマクロについて教えてください。 1 2022/03/25 10:03
- プリンタ・スキャナー epsonのプリンターでカラー印刷ができない 3 2023/04/28 01:03
- プリンタ・スキャナー 印刷ができない 6 2022/04/01 20:47
- プリンタ・スキャナー 2台のプリンター 3 2022/06/29 14:07
- プリンタ・スキャナー キャノンmp490プリンター【エラー番号5400】で【プリンタートラブルが発生しました。電源を入れ直 2 2023/07/24 17:45
- プリンタ・スキャナー 封筒印刷 差出人印刷ずれる 4 2022/05/01 10:12
- Visual Basic(VBA) VBAで不特定枚数印刷をしたいです。 4 2022/08/02 07:30
- ノートパソコン Windows11homeを新しく購入し、初期設定をしています。 前のパソコンでは無線のFAX機や有 5 2023/04/18 19:50
- プリンタ・スキャナー 2台のプリンターでそれぞれ異なる様式の帳票を印刷したい。 2 2022/09/06 10:07
- Windows 10 プリンターを削除したい 4 2022/10/19 16:52
このQ&Aを見た人はこんなQ&Aも見ています
関連するカテゴリからQ&Aを探す
おすすめ情報
このQ&Aを見た人がよく見るQ&A
デイリーランキングこのカテゴリの人気デイリーQ&Aランキング
-
Excelの左真ん中に印を
-
プリンターの情報を取得してい...
-
epson のプリンターで印刷をし...
-
・windows7でcanonのBJ F360を...
-
プリンターに関しての質問です。
-
プリンタを誤って削除、直し方...
-
同機種のプリンターを買った場...
-
エクセルVBAで手差しトレイを指...
-
エクセルの余白の塗りつぶし方法
-
印刷プレビューにない文字が印...
-
複数のシートを一括で手差し→自...
-
エクセルの用紙サイズについて...
-
マクロでプリンタ、用紙、給紙...
-
WIN10でプリンタを削除してもポ...
-
「指定したPPDは無効です」でプ...
-
太文字が印刷されない。
-
会社のパソコンで、 誤って「プ...
-
プリンターにUSBハブを使って複...
-
印刷をしようとするとFAX送...
-
プリンターでスキャンした資料...
マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング
-
Excelの左真ん中に印を
-
故障が殆どゼロの、価格の安い...
-
2回目以降の印刷をプリンターが...
-
epson のプリンターで印刷をし...
-
PSプリンタードライバーとPPD
-
突然、プリントアウトができな...
-
キューに1個のドキュメント
-
エクセルVBAで最高画質印刷
-
パソコンの新しくプリンターを...
-
ドットプリンターで現金書留の...
-
至急お願いします! プリンター...
-
通常使うプリンタ、以外のプリ...
-
CAD図面の連続印刷が出来ません。
-
ワードのファイルサイズが大き...
-
FMV DESKPOWER C4/737 でプリン...
-
A1サイズの印刷ができ、Mac対応...
-
OneNoteって?
-
やよい会計で確定申告:印刷で...
-
Excel・VBAでのプリンタ指定
-
プリンターの情報を取得してい...
おすすめ情報