VBAでデータベースからの作表・印刷処理を自動化する 2

Excel VBAでさまざまな表印刷を行う － ユーザーフォーム編

完成ソース

リスト5

Dim RowNo As Integer, ColumnNo As Integer

Private Sub UserForm_Initialize()
    With ComboBox1
        .AddItem "地球連邦軍"
        .AddItem "ジオン公国軍"
        .AddItem "エゥーゴ"
        .AddItem "ティターンズ"
        .AddItem "ネオ・ジオン"
        .Text = .List(0)
    End With
End Sub

Private Sub CommandButton1_Click()
    Dim SQLstring As String

    '前回のセルデータを消去
    Worksheets("Sheet1").Cells.Select
    Selection.Clear
    Range("A1").Select

    'データベースを開きクエリを実行する
    Select Case ComboBox1.Text
        Case "地球連邦軍"
            SQLstring = "Select * from MSデータ 
                          Where MSデータ.所属 = '地球連邦軍'"
        Case "ジオン公国軍"
            SQLstring = "Select * from MSデータ 
                          Where MSデータ.所属 = 'ジオン公国軍'"
        Case "エゥーゴ"
            SQLstring = "Select * from MSデータ 
                          Where MSデータ.所属 = 'エゥーゴ'"
        Case "ティターンズ"
            SQLstring = "Select * from MSデータ 
                          Where MSデータ.所属 = 'ティターンズ'"
        Case "ネオ・ジオン"
            SQLstring = "Select * from MSデータ 
                          Where MSデータ.所属 = 'ネオ・ジオン'"
    End Select

    ColumnNo = 4
    RowNo = Module2.DBAccess(SQLstring, ColumnNo)

End Sub

Private Sub ToggleButton1_Click()
    Range("A1").Select
    If ToggleButton1.Value = True Then
        ToggleButton2.Value = False
        ToggleButton3.Value = False
        ToggleButton4.Value = False
        Selection.AutoFormat Format:=xlRangeAutoFormatColor1
    Else
        Selection.AutoFormat Format:=xlRangeAutoFormatNone
    End If

End Sub

Private Sub ToggleButton2_Click()
    Range("A1").Select
    If ToggleButton2.Value = True Then
        ToggleButton1.Value = False
        ToggleButton3.Value = False
        ToggleButton4.Value = False
        Selection.AutoFormat Format:=xlRangeAutoFormatColor2
    Else
        Selection.AutoFormat Format:=xlRangeAutoFormatNone
    End If

End Sub

Private Sub ToggleButton3_Click()
    Range("A1").Select
    If ToggleButton3.Value = True Then
        ToggleButton2.Value = False
        ToggleButton1.Value = False
        ToggleButton4.Value = False
        Selection.AutoFormat Format:=xlRangeAutoFormatClassic2
    Else
        Selection.AutoFormat Format:=xlRangeAutoFormatNone
    End If
End Sub

Private Sub ToggleButton4_Click()
    Range("A1").Select
    If ToggleButton4.Value = True Then
        ToggleButton2.Value = False
        ToggleButton3.Value = False
        ToggleButton1.Value = False
        Selection.AutoFormat Format:=xlRangeAutoFormatList1
    Else
        Selection.AutoFormat Format:=xlRangeAutoFormatNone
    End If
End Sub

Private Sub SpinButton1_Change()
    Label1.Caption = SpinButton1.Value
End Sub

Private Sub CommandButton2_Click()
    Dim Ret As Integer
    Dim Ttl As Single
    Dim Title As String

    If RowNo = 0 Then
        MsgBox "クエリを実行してください"
        Exit Sub
    End If

    '表のタイトル設定
    Title = TextBox1.Text

    'オートフィットを実行
    Range(Cells(1, 1), Cells(1, ColumnNo)).Select
    Selection.EntireColumn.AutoFit

    For i = 1 To ColumnNo
        Ttl = Ttl + Cells(1, i).Width
    Next

    Ttl = Round(Ttl * 0.35) / 10

    'A4縦の横幅は約21cm、用紙が横の場合は約30cm
    Select Case Ttl
        Case Is < 17
            Call Module1.PrintSet("A4縦", 2, Title)
        Case 17 To 19
            '左右のマージンで調整
            Call Module1.PrintSet("A4縦", 1, Title) 
        Case 20 To 26
            Call Module1.PrintSet("A4横", 2, Title)
        Case 27 To 28
            Call Module1.PrintSet("A4横", 1, Title)
        Case Is > 28
            Call Module1.FitPage(Title) 'データを用紙に収めて印刷する
    End Select

    '白黒印刷設定
    If CheckBox1.Value = True Then
        Worksheets("Sheet1").PageSetup.BlackAndWhite = True
    Else
        Worksheets("Sheet1").PageSetup.BlackAndWhite = False
    End If

    'ページ番号印刷設定
    If CheckBox2.Value = True Then
        Worksheets("Sheet1").PageSetup.CenterFooter = "- &P -"
    Else
        Worksheets("Sheet1").PageSetup.CenterFooter = ""
    End If

    '行列番号印刷設定
    If CheckBox3.Value = True Then
        Worksheets("Sheet1").PageSetup.PrintHeadings = True
    Else
        Worksheets("Sheet1").PageSetup.PrintHeadings = False
    End If


    '印刷開始
    With Worksheets("Sheet1")
        .Range("A1").Select
        .PrintOut Copies:=SpinButton1.Value
    End With

    RowNo = 0
End Sub

Private Sub CommandButton3_Click()
    Unload Me
    End
End Sub

まとめ

　2回に分けて、Excelのページ設定と印刷設定機能を組み合わせ、印刷処理を自動化してみました。印刷スタイルそのものは、用紙サイズ・印刷方向とマージンの設定ぐらいしかできませんが、それでも式と組み合わせれば使えるマクロに仕上がるのではないでしょうか。

補足：PaperSizeプロパティの設定値について

　PaperSizeプロパティの設定値は以下の通りになります。

値	意味
xlPaperLetter	レター (8 1/2 x 11 インチ)
xlPaperLetterSmall	レター (小型) (8 1/2 x 11 インチ)
xlPaperTabloid	タブロイド (11 x 17 インチ)
xlPaperLedger	レジャ (17 x 11 インチ)
xlPaperLegal	リーガル (8 1/2 x 14 インチ)
xlPaperStatement	ステートメント (5 1/2 x 8 1/2 インチ)
xlPaperExecutive	エグゼクティブ (7 1/2 x 10 1/2 インチ)
xlPaperA3	A3 (297 mm x 420 mm)
xlPaperA4	A4 (210 mm x 297 mm)
xlPaperA4Small	A4 (小型) (210 x 297 mm)
xlPaperA5	A5 (148 mm x 210 mm)
xlPaperB4	B4 (250 mm x 354 mm)
xlPaperB5	B5 (182 mm x 257 mm)
xlPaperFolio	フォリオ (8 1/2 x 13 インチ)
xlPaperQuarto	カート (215 x 275 mm)
xlPaper10x14	10 x 14 インチ
xlPaper11x17	11 x 17 インチ
xlPaperNote	ノート (8 1/2 x 11 インチ)
xlPaperEnvelope9	封筒 9 号 (3 7/8 x 8 7/8 インチ)
xlPaperEnvelope10	封筒 10 号 (4 1/8 x 9 1/2 インチ)
xlPaperEnvelope11	封筒 11 号 (4 1/2 x 10 3/8 インチ)
xlPaperEnvelope12	封筒 12 号 (4 1/2 x 11 インチ)
xlPaperEnvelope14	封筒 14 号 (5 x 11 1/2 インチ)
xlPaperCsheet	C シート
xlPaperDsheet	D シート
xlPaperEsheet	E シート
xlPaperEnvelopeDL	封筒 DL (110 x 220 mm)
xlPaperEnvelopeC3	封筒 C3 (324 x 458 mm)
xlPaperEnvelopeC4	封筒 C4 (229 x 324 mm)
xlPaperEnvelopeC5	封筒 C5 (162 x 229 mm)
xlPaperEnvelopeC6	封筒 C6 (114 mm x 162 mm)
xlPaperEnvelopeC65	封筒 C65 (114 mm x 229 mm)
xlPaperEnvelopeB4	封筒 B4 (250 mm x 353 mm)
xlPaperEnvelopeB5	封筒 B5 (176 mm x 250 mm)
xlPaperEnvelopeB6	封筒 B6 (176 mm x 125 mm)
xlPaperEnvelopeItaly	封筒 (110 mm x 230 mm)
xlPaperEnvelopeMonarch	封筒モナーク (3-7/8 x 7-1/2 インチ)
xlPaperEnvelopePersonal	封筒 (3-5/8 x 6-1/2 インチ)
xlPaperFanfoldUS	U.S. Standard Fanfold (14-7/8 x 11 インチ)
xlPaperFanfoldStdGerman	German Standard Fanfold (8-1/2 x 12 インチ)
xlPaperFanfoldLegalGerman	German Legal Fanfold (8-1/2 x 13 インチ)
xlPaperUser	ユーザー設定