Sample Macro  印刷 [応用型] Previous Next

1) 伸縮する表の印刷 このページのトップへ もくじへ 使用可能なExcelのバージョン
'=================================================================================
Sub 伸縮する罫線ない表の印刷_印刷範囲設定なし()    '※1,4
    Sheets("SSS").Select                        '※2
    Range("A1").CurrentRegion.Select            'アクティブセル領域を選択 ※3
    印刷枚数 = 1                                '任意の枚数
    ActiveWindow.SelectedSheets.PrintOut Copies:=印刷枚数
End Sub
'---------------------------------------------------------------------------------
Sub 伸縮する罫線ない表の印刷_印刷範囲設定あり()    '※1,4
    Sheets("SSS").Select                        '※2
    Range("A1").CurrentRegion.Select            'アクティブセル領域を選択 ※3
    ActiveSheet.PageSetup.PrintArea = Selection.Address '印刷範囲を設定し直す
    印刷枚数 = 1                                '任意の枚数
    ActiveWindow.SelectedSheets.PrintOut Copies:=印刷枚数
End Sub
'---------------------------------------------------------------------------------
Sub 伸縮する罫線ある表の印刷_印刷範囲設定あり()
    Sheets("SSS").Select                        '※2,5
        Range("D2").Select                      '印刷制御列のデータの先頭行
        Selection.AutoFilter                    'オートフィルターをリセット
        Selection.AutoFilter Field:=1, Criteria1:="p" 'D列がpの行を抜き出し ※5
        印刷枚数 = 1                            '任意の枚数
        ActiveWindow.SelectedSheets.PrintOut Copies:=印刷枚数
        Selection.AutoFilter
End Sub
'=================================================================================
<コメント>
※1 印刷範囲(ファイル-ページ設定-シートにて)が事前に設定してある場合と、してない場合
※2 SSSにはシート名を記入
※3 A1には左上端セルを記入
※4 下図の場合は A1:D7の範囲 が印刷される
表サンプル
※5 下図の場合は A1:B12の中のA6:B11以外の範囲 が印刷される
表サンプル


2) DBから請求書を印刷 このページのトップへ もくじへ 使用可能なExcelのバージョン
'=================================================================================
Option Explicit
Dim 用紙 As String                  '請求書用紙のシート名
Dim データ As String                'データベースのシート名
Dim ピボット As String              'ピボットテーブルのシート名
Dim 消費税率 As Integer             '消費税率
Dim ブック名 As String              'このブックの名前
Dim 日付入力キャン As Integer       '日付入力でキャンセルが押されると1
Dim 年月日 As String                '請求書日付の入力用
Private ソース As String            'ソースデータの範囲
Private テーブル先 As String        'ピボットテーブル作成先
Private テーブル名 As String        'ピボットテーブルの名前
Private 下端 As Integer             '下端の行数
Private 右端 As Integer             '右端の列名
Private 縦 As Integer               '行
Private 横 As Integer               '列
Private 貼付行 As Integer           '請求書用紙の貼り付ける行
Private 小計 As Long                '売上金額の小計
Private 消費税 As Long              '消費税
'=================================================================================
Sub 請求書作成()
    ブック名 = ActiveWorkbook.Name              'このブックの名前
    用紙 = "請求書"                             '※1 請求書用紙のシート名
    データ = "DB"                             '※2 データベースのシート名
    ピボット = "ピボット"                       '※3 ピボットテーブルのシート名
    消費税率 = 5                                '※4 消費税率として5%をセット

    Sheets(用紙).Select
        Range("G6").ClearContents               '年月日をクリア
        Range("E11").ClearContents              '社名をクリア
        Range("E18").ClearContents              'ご請求額をクリア
        Range("C22:J31").ClearContents          '明細欄をクリア
        Range("K32").Select                     'カーソルを退避させる

日付入力:
    日付を入力する
    If 日付入力キャン = 1 Then                  'キャンセルボタンがクリックされた場合
        exit sub
    End If
    If Len(年月日) <> 8 Then                    '入力日付が8桁でない場合
        GoTo 日付入力
    End If
    ピボットテーブルを作成する
    Application.ScreenUpdating = True           '画面を更新する
    ピボットテーブルから売上データを取り出しながら請求書を印刷する
End Sub
'---------------------------------------------------------------------------------
Private Sub 日付を入力する()
    日付入力キャン = 0
    年月日 = Application.InputBox(prompt:="西暦8桁(YYYYMMDD)で入れてください", _
        Title:="    請求年月日の入力", Type:=1)
    If 年月日 = False Then                  'キャンセルボタンをクリック
        日付入力キャン = 1
        Exit Sub
    End If
    Cells(6, 7) = Left(年月日, 4) & "/" & Mid(年月日, 5, 2) & "/" & Right(年月日, 2)
                                                '請求日付
End Sub
'---------------------------------------------------------------------------------
Private Sub ピボットテーブルを作成する()
    Sheets(ピボット).Cells.Clear                'すべてクリア
    Sheets(データ).Select
        下端 = Range(Cells(1, 1), Cells(1, 1)).End(xlDown).Row '下端検出
        Range("A2").Select
        ソース = データ & "!R1C1:R" & 下端 & "C3"      '
        テーブル先 = "[" & ブック名 & "]" & ピボット & "!R1C1"
        テーブル名 = "請求先別売上"
        ActiveSheet.PivotTableWizard SourceType:=xlDatabase, SourceData:= _
            ソース, TableDestination:=テーブル先, TableName:=テーブル名
        ActiveSheet.PivotTables(テーブル名).AddFields RowFields:="社名", _
            ColumnFields:="内容"
        ActiveSheet.PivotTables(テーブル名).PivotFields("売上").Orientation _
            = xlDataField
End Sub
'---------------------------------------------------------------------------------
Private Sub ピボットテーブルから売上データを取り出しながら請求書を印刷する()
    下端 = Sheets(ピボット).Range("B3").End(xlDown).Row       '下端検出
    右端 = Sheets(ピボット).Range("B3").End(xlToRight).Column '右端検出
    Sheets(用紙).Select
        For 縦 = 3 To 下端 - 1                  'ピボットテーブルの3行目~最下行-1
            Range("C22:J31").ClearContents      '明細欄をクリア
            Cells(11, 5) = Sheets(ピボット).Cells(縦, 1) '社名
            貼付行 = 22                         '請求書用紙の金額欄の最上行
            For 横 = 2 To 右端 - 1
                Cells(貼付行, 4) = " " & Sheets(ピボット).Cells(2, 横)  '内容
                Cells(貼付行, 9) = " " & Sheets(ピボット).Cells(縦, 横) '売上
                貼付行 = 貼付行 + 1
            Next
            小計 = Sheets(ピボット).Cells(縦, 右端) '横計
            Cells(貼付行, 6) = "小 計"
            Cells(貼付行, 9) = 小計             '小計
            消費税 = Application.Round(小計 * 消費税率 / 100, 0)
            Cells(貼付行 + 1, 6) = "消費税"
            Cells(貼付行 + 1, 9) = 消費税       '消費税
            Cells(貼付行 + 2, 6) = "合 計"
            Cells(貼付行 + 2, 9) = 小計 + 消費税 '合計
            Cells(18, 5) = 小計 + 消費税        'ご請求額
            ActiveWindow.SelectedSheets.PrintOut Copies:=1 '印刷
        Next
End Sub
'=================================================================================
<コメント>
※1~3 ""の中の各シートの名前は変更可能
※4 消費税率に合わせて変更可能
※5 データベースのレイアウト
DB
※6 請求書のレイアウトは こちら
※7 サンプルマクロ 請求書作成」をダウンロード すれば実際に動かしながら見れます。


3) 印刷させない このページのトップへ もくじへ 使用可能なExcelのバージョン
'=================================================================================
Private Sub Workbook_BeforePrint(Cancel As Boolean)
    Cancel = True                               '※1
    タイトル = "ペーパーレス運動実施中!"
    スタイル = 48                               'vbexclamation
    メッセージ = "印刷しないでください"
    応答 = MsgBox(メッセージ, スタイル, タイトル)
End Sub
'=================================================================================
<コメント>
※1 ブックオブジェクトのイベント(この場合は印刷)を無効にする
※2 「ThisWorkbook」のコードとして作成する
サンプルブックのダウンロードは ここをクリック (YNxv261_NotPrint.xls 26KB)
※ 一旦、ブックをハードディスクに保存し、開き直してから実行してください。


4) セルの値を印刷しないようにしてから印刷する このページのトップへ もくじへ 使用可能なExcelのバージョン
'=================================================================================
Sub セルの値を印刷しないようにしてから印刷する()
    セル = "A2"                                 '※1
    With Worksheets("SSS")                      '※2
        元の表示形式 = .Range(セル).NumberFormatLocal '表示形式を取得
        .Range(セル).NumberFormatLocal = ";;;"
        .PrintPreview                           '※3
        .Range(セル).NumberFormatLocal = 元の表示形式
    End With
End Sub
'=================================================================================
<コメント>
※1 A2にはセル範囲を記入
※2 SSSにはワークシート名を記入
※3 便宜上、印刷プレビューにしてある


5) 印刷範囲を設定するだけ このページのトップへ もくじへ 使用可能なExcelのバージョン
'=================================================================================
Sub 印刷しないで印刷範囲を設定するだけ_間接指定()
    Worksheets("SSS").Activate                  'ワークシートをアクティブにする ※1
    ActiveSheet.PageSetup.PrintArea = ""        '印刷範囲をクリアする
    Range(Cells(4, 4), Cells(5, 5)).Select      '印刷範囲としたいセル範囲を選択する ※2
    With Selection                              '選択されたセル範囲の
        行数 = .Rows.Count                      '行数を取得する
        列数 = .Columns.Count                   '列数を取得する
        印刷範囲 = .Cells(1, 1).Address & ":" & .Cells(行数, 列数).Address
                                                '印刷範囲を表す文字列変数を作成する
    End With
    ActiveSheet.PageSetup.PrintArea = 印刷範囲  '印刷範囲を設定する
End Sub
'---------------------------------------------------------------------------------
Sub 印刷しないで印刷範囲を設定するだけ_直接指定()
    Worksheets("SSS").Activate                  '※1
    ActiveSheet.PageSetup.PrintArea = ""
    Range(Cells(4, 4), Cells(5, 5)).Select      '※2
    With Selection
        印刷範囲 = .Cells(1, 1).Address & ":" & .Cells(.Rows.Count, .Columns.Count).Address
    End With
    ActiveSheet.PageSetup.PrintArea = 印刷範囲
End Sub
'=================================================================================
<コメント>
※1 SSSにはワークシート名を記入
※2 4,4、5,5には行・列番号を記入
※3 解説ページは こちら
サンプルブックのダウンロードは ここをクリック (YNxv261_PrintArea.xls 32KB)
※ 一旦、ブックをハードディスクに保存し、開き直してから実行してください。


6) プリンターを指定する このページのトップへ もくじへ 使用可能なExcelのバージョン
'=================================================================================
Sub 現在使用しているプリンター名を取得する()
    プリンター名 = Application.ActivePrinter    '現在使用しているプリンター名を取得する
    MsgBox "現在使用しているプリンター名: " & プリンター名, vbInformation, "すぐマク"
End Sub
'---------------------------------------------------------------------------------
Sub 現在使用しているプリンターの名前を設定する()
    印刷ポート = "LPT1:"                        '※1
    印刷ドライバー = "Canon BJ F300"            '※2
    If Application.Version = "9.0" Then         'Excel 2000なら
        プリンター名 = 印刷ポート & " の " & 印刷ドライバー 'プリンター名の文字列を作成
        Application.ActivePrinter = プリンター名  '現在使用プリンターの名前を設定する
    Else
        MsgBox "このサンプルは Excel2000用です", vbCritical, "すぐマク"
    End If
End Sub
'---------------------------------------------------------------------------------
Sub プリンターを指定して印刷する()
    印刷部数 = 1                                '※3
    印刷ポート = "LPT1:"                        '※1
    印刷ドライバー = "Canon BJ F300"            '※2
    部単位印刷 = True                           '※4
    If Application.Version = "9.0" Then         'Excel 2000なら
        プリンター名 = 印刷ポート & " の " & 印刷ドライバー 'プリンター名の文字列を作成
        ActiveWindow.SelectedSheets.PrintOut Copies:=印刷部数, _
        ActivePrinter:=プリンター名, Collate:=部単位印刷 'プリンターを指定して印刷する ※5
    Else
        MsgBox "このサンプルは Excel2000用です", vbCritical, "すぐマク"
    End If
End Sub
'---------------------------------------------------------------------------------
Sub 通常使うプリンターに設定するためのダイアログボックスを表示する()
    Shell ("Control.exe Printers")
End Sub
'=================================================================================
<コメント>
※1 "LPT1:" には印刷先のポート名を記入、
   ネットワークプリンターの場合は"\\pppp\nnnn"のようにパスとプリンター名を記入
   調べ方:[スタート]-[設定]-[プリンター]とクリック、プリンターアイコンを右クリックして
   [プロパティ]
※2 "Canon BJ F300" には印刷に使用するドライバー名を記入
※3 1 には印刷部数(枚数)を記入
※4 部単位印刷する場合は True、しない場合は False
※5 部単位印刷の引数 Collate は省略可能(既定値 True)


7) プリンターを一時変更する このページのトップへ もくじへ 使用可能なExcelのバージョン
'=================================================================================
Sub 現在使用しているプリンター名を一時変更する()  '標準モジュールに記述する方法
    旧プリンター名 = Application.ActivePrinter    '現在使用しているプリンター名を取得する
    印刷ポート = "LPT1:"                        '※1
    印刷ドライバー = "Canon BJ F300"            '※2
    If Application.Version = "9.0" Then         'Excel 2000なら
        新プリンター名 = 印刷ポート & " の " & 印刷ドライバー '新プリンター名を作成
        Application.ActivePrinter = 新プリンター名 '現在使用しているプリンター名を設定する
    Else                                        'Excel 2000でないなら
        Exit Sub
    End If
    Application.ActivePrinter = 旧プリンター名  '現在使用しているプリンター名を元に戻す
End Sub
'=================================================================================
Option Explicit                                 'ThisWorkbookのコード画面に記述する方法
Dim 旧プリンター名 As String
Dim 新プリンター名 As String
Dim 印刷ポート As String
Dim 印刷ドライバー As String

Private Sub Workbook_Open()
    旧プリンター名 = Application.ActivePrinter  '現在使用しているプリンター名を取得する
    印刷ポート = "LPT1:"                        '※1
    印刷ドライバー = "Canon BJ F300"            '※2
    新プリンター名 = 印刷ポート & " の " & 印刷ドライバー '新プリンター名の文字列を作成
    Application.ActivePrinter = 新プリンター名  '現在使用しているプリンター名を設定する
End Sub

Private Sub Workbook_BeforeClose(Cancel As Boolean)
    Application.ActivePrinter = 旧プリンター名  '現在使用しているプリンター名を元に戻す
End Sub
'=================================================================================
<コメント>
※1 "LPT1:" には印刷先のポート名を記入、
   ネットワークプリンターの場合は"\\pppp\nnnn"のようにパスとプリンター名を記入
   調べ方:[スタート]-[設定]-[プリンター]とクリック、プリンターアイコン右クリックして[プロパティ]
※2 "Canon BJ F300" には印刷に使用するドライバー名を記入

Excel VBA Macro