[[20160621213546]]　『未対応用紙サイズの場合、印刷しない』（楓）　ページの最後に飛ぶ

『未対応用紙サイズの場合、印刷しない』（楓）

いつもお世話になります。

VBAにて印刷設定を行っています。

印刷したいサイズはＡ３です。
しかし、プリンターによってはＡ４までしか用紙印刷できないです。
その場合に、印刷しないように処理をしたいのですが、可能でしょうか？

なお、プリンター機種の固定はありません。

実際にＡ４までしかいれれないプリンターで行ってみたところ
Ａ４に縮小されて印刷されてしまいました。

'用紙サイズを設定
Sheets(1).PageSetup.PaperSize = xlPaperA3
'対象シートを印刷
Sheets(1).PrintOut

で印刷設定しています。

よろしくお願いいたします。

＜使用 Excel：Excel2007、使用 OS：WindowsVista ＞

 こんばんわ。

 今回の要件を満たすにはAPIでの処理になると思います。

 こちらでAPIでのアクティブプリンターの印刷可能用紙の一覧が取得できる方法が紹介されています。

https://support.microsoft.com/ja-jp/kb/229718

 sNextStringがA3かどうか判断すれば良いかと。

（sy） 2016/06/21(火) 22:29

 上記のAPI無理ですね、すいません。

 サポートされてる用紙と出力可能用紙は違いました。

 出力可能用紙の取得は、ちょっと分からないです。

 お力になれず、申し訳ありません。

（sy） 2016/06/21(火) 23:54

Private Sub Workbook_BeforePrint(Cancel As Boolean)

    If ActiveSheet.Name = "Sheet1" Then '対象シート名
        If ActiveSheet.PageSetup.Zoom * 1 < 100 And ActiveSheet.PageSetup.PaperSize <> 8 Then
        Cancel = True
        End If
    End If
End Sub
（mm） 2016/06/22(水) 10:13

 失礼します。

 To mm さん

 質問の中では

 >>Sheets(1).PageSetup.PaperSize = xlPaperA3 
 >>Sheets(1).PrintOut

 と、シートを特定して印刷指示を出してますね。かならずしも Sheets(1) がアクティブではないという前提ですが
 回答コード内で ActiveSheet の状態をチェックしておられる意図は？

 それと、ActiveSheet.PageSetup.PaperSize <> 8　でいいのでしょうか？
 A3 じゃなかったら　ということになってません？

（β） 2016/06/22(水) 10:31

 To mmさん

 ActiveSheet.PageSetup.Zoom * 1　は、EXCEL側の印刷設定でのZoomですので、
 私のA4プリンタで試した時にプリンタ側で勝手に縮小印刷されるのはキャンセル出来ませんでした。

 今回の質問は、プリンタ側で勝手に縮小される場合にキャンセルしたい。なので、
 プリンタ側(ドライバの対応してる用紙でない)の出力可能用紙を取得する必要があると思います。

（sy） 2016/06/22(水) 20:59

 試していませんが、【VBA プリンタで対応している用紙サイズの取得】で検索すると
 こんなページがありました。

http://locosoft.cocolog-nifty.com/blog/2012/03/excel-vba-820b.html

（β） 2016/06/22(水) 21:43

 To βさん

 ご紹介のページは、私の提示したページと基本同じ取得方法ですね。
 ドライバのサポート用紙すべてが抽出されました。

 出力可能用紙か、印刷時のプリンタ側の縮尺率かオートフィットの有無のどれかを取得できれば良いんでしょうが、
 調べても中々出てこないですね。

 非常に難しい。。。

（sy） 2016/06/22(水) 22:02

おはようございます。

みなさん、ありがとうございます。
やはりこればかりはなかなか難しい所なんでしょうかね・・・

とりあえずはメッセージでキャンセルできるようにしておこうと思います。

もし、なにかいい方法でましたら宜しくお願いします！！
（楓） 2016/06/23(木) 09:06

 コード内で完結出来る方法は、私には難しすぎるので
 上級者の回答を待ってもらうとして、代替え案ですが、

 コードは夜までUP出来ないですが、
 A4まで対応のプリンター名のリストを作成し、
 APIでアクティブプリンター名を取得して、
 COUNTIFで見つかればキャンセルではどうでしょう？

 そんなに台数も多くないと思いますし、一度登録すればずっと
 使えるので手間は少ないと思います。

（sy） 2016/06/23(木) 10:14

 こんばんわ。

 代替え案ですけど、こんなのでどうでしょうか？

 「プリンター一覧」シートを用意して、そのプリンターでの初回印刷時にメッセージを出して、印刷させるかどうかを、
 ユーザーが選択し、「いいえ」を選択したプリンターはA3印刷の時は印刷しないにようにします。
 間違えて一覧に登録した場合は手動で修正して下さい。
 プリンター名の横に1があれば「印刷しない」になります。
 以下コードです。

 Private Sub Workbook_BeforePrint(Cancel As Boolean)
    Dim pName As String
    Dim msg
    Dim wsh As Object
    Dim shP As Worksheet, sh As Worksheet
    Dim rng As Range

    Set sh = Sheets(1)
    Set shP = Sheets("プリンター一覧")

    '印刷範囲がA3、100％ズーム
    If sh.PageSetup.Zoom * 1 = 100 And sh.PageSetup.PaperSize = 8 Then

        'アクティブプリンター名取得
        pName = Left(ActivePrinter, InStr(ActivePrinter, " on") - 1)

        'リスト登録の有無
        If WorksheetFunction.CountIf(shP.Range("A:A"), pName) = 0 Then

            'リストに無ければ確認メッセージ
            msg = MsgBox("このプリンターでA3を印刷しますか？" & vbLf & _
                    "プリンター名　：　" & pName, vbYesNoCancel + vbDefaultButton1)

            If msg <> vbCancel Then
                'リストにプリンター名を登録
                Set rng = shP.Range("A" & Rows.Count).End(xlUp).Offset(1)
                rng.Value = pName

                '印刷を許可しない場合は1を登録
                If msg = vbNo Then
                    rng.Offset(, 1).Value = 1
                    Cancel = True
                End If

            Else
                '印刷及び登録をキャンセル
                Cancel = True
            End If
        Else

            'リストに印刷不可で登録されていたらキャンセル
            If WorksheetFunction.CountIfs(shP.Range("A:A"), pName, _
                    shP.Range("B:B"), 1) = 1 Then
                Cancel = True
                Set wsh = CreateObject("WScript.Shell")
                wsh.popup pName & vbLf & "はA3印刷に未対応です。", 1
                Set wsh = Nothing
            End If
        End If
    End If

    Set sh = Nothing
    Set shP = Nothing

 End Sub

（sy） 2016/06/23(木) 21:00

 こんばんわ。

 もしかしたら以下のコードで出来るかも知れません。

 会社のA3プリンターでサポート用紙一覧を出力したら、A3はレターなどよりも上に表示されました。
 自宅のA4までのプリンターでは実際に印刷可能な用紙よりも下に表示されました。

 上記の事からA3対応プリンターでは、サポート用紙を順番に読み込んだ時に、上から10番目以内くらいまでに表示されるのではないかと思います。

 なので以下のコードでは、サポート用紙を順番に読み込んで、10番目までにA3用紙が出て来なかったら印刷をキャンセルします。

 ただ会社はNECの1機種で統一しているのと、自宅もEPSONの1台しか無いので、検証数が少なすぎて全てのプリンターに当てはまると言う確証はありません。

 でも試す価値はあると思います。

 以下コードです、ThisWorkbookモジュールに貼付けて下さい。

 'プリンター呼出用の宣言
 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 Const DC_PAPERS = 2

 Public Function GetA3PaperSize(SizeNum As Integer) As Boolean
    Dim hPrinter As Long
    Dim sDeviceName As String
    Dim iPaperSize(1 To 1000) As Integer
    Dim i As Long

    '初期設定
    GetA3PaperSize = True

    'プリンター名取得
    sDeviceName = Left(ActivePrinter, InStr(1, ActivePrinter, " on ") - 1)

    'プリンター呼出
    If OpenPrinter(sDeviceName, hPrinter, 0) <> 0 Then

        '用紙番号を取得
        Call DeviceCapabilities(sDeviceName, "", DC_PAPERS, iPaperSize(1), ByVal vbNullString)

        'A3用紙対応なら印刷指示
        For i = 1 To 10
            If iPaperSize(i) = 8 Then
                GetA3PaperSize = False
                Exit For
            End If
        Next i

        'プリンター解放
        ClosePrinter (hPrinter)
    End If

 End Function

 Private Sub Workbook_BeforePrint(Cancel As Boolean)

    '印刷範囲がA3で100%ズームの時に、プリンターがA3未対応なら印刷しない
    With ActiveSheet.PageSetup
        If .Zoom * 1 = 100 And .PaperSize = 8 Then Cancel = GetA3PaperSize(8)
    End With

 End Sub

 少し修正しました(6:23)

（sy） 2016/06/26(日) 23:32

sy様

ありがとうございます！
実際、使用するプリンターの種類が不明ではあったのでこういったほうが助かります。

会社のはA3対応なので、家や別の場所のプリンターなどでも試してみます！
（楓） 2016/06/28(火) 10:05

コメント返信：

[ 一覧(最新更新順) ]

[[20160621213546]] 『未対応用紙サイズの場合、印刷しない』（楓） ページの最後に飛ぶ

[[20160621213546]]　『未対応用紙サイズの場合、印刷しない』（楓）　ページの最後に飛ぶ