エクセルマニア

VBA 時間

TOP > VBA・マクロ >  VBからEXCELに出力して印刷する
このエントリーをはてなブックマークに追加

VBからEXCELを介して印刷するVBのサンプルプログラム

VBで帳票を作ると以外に手間で、変更も大変です。そこで一度EXCELに出力してしまえば・・・ということでVB→EXCEL→印刷というプログラムをご紹介します。 このサンプルプログラムでは、EXCELを表示してあとはEXCELで印刷ボタンを押すだけの状態ですが、 改良すればEXCELを表示せず(隠したまま)印刷してしまうこともできます。 また、EXCEL2003 や EXCEL2010 など バージョンを選ばない(COMの参照を使用しない)実装方法ですが、何かしらのバージョンのEXCELはインストールされている必要があります。


Dim xlApp
Dim xlBook
Dim xlSheet
Dim xlWindow


Dim i As Integer = 0
Dim j As Integer = 0
Dim k As Integer = 0
Dim outfile As String = ""

Try

    Me.Cursor = Cursors.WaitCursor

    ' EXCELファイルを開く
    xlApp = CreateObject("Excel.Application") 
    xlApp.Visible = True	'EXCELの表示します。プログラム終了後でもOKです。

    xlApp.Workbooks.Add()	'新規ブックを作成する
    xlBook = xlApp.ActiveWorkbook	'Workbook
    xlSheet = xlBook.ActiveSheet	'Worksheet

    '1行目(番号、氏名、TEL)
    xlSheet.Cells(1, 1).Value = "番号"
    xlSheet.Cells(1, 2).Value = "氏名"
    xlSheet.Cells(1, 3).Value = "TEL"


    xlSheet.Cells(1, 1).ColumnWidth = 5
    xlSheet.Cells(1, 2).ColumnWidth = 10
    xlSheet.Cells(1, 3).ColumnWidth = 12

	'印刷時に全ページに表のタイトルを印刷(1行目)します。
	xlSheet.PageSetup.PrintTitleRows = "$1:$1"


    For Each row As DataGridViewRow In dgv.Rows()
    
    	'DataGridView をループしてEXCELに転記する例。row1、row2 は設定している列名
        xlSheet.Cells(i, 1).Value = i + 1
        xlSheet.Cells(i, 2).Value = row.Cells("row1").Value
        xlSheet.Cells(i, 3).Value = row.Cells("row2").Value

		'念のため1行づつ改ページを削除
        xlSheet.Range(xlSheet.Cells(i, 1), xlSheet.Cells(i, 3)).PageBreak = -4142

		'10行づつ改ページに
        If (i + 1) Mod 10 = 0  Then
            xlSheet.Range(xlSheet.Cells(i, 1), xlSheet.Cells(i, 3)).PageBreak = -4135
        End If

        i = i + 1
    Next

	'罫線を引く
    xlSheet.Range(xlSheet.Cells(1, 1), xlSheet.Cells(i - 1, 3)).Borders.Color = QBColor(0)
    xlSheet.Range(xlSheet.Cells(1, 1), xlSheet.Cells(i - 1, 3)).Borders.LineStyle = 1
    xlSheet.Range(xlSheet.Cells(1, 1), xlSheet.Cells(i - 1, 3)).Borders.Weight = 2

	'全ての行の高さを30に
    xlSheet.Range(xlSheet.Cells(1, 1), xlSheet.Cells(i - 1, 3)).RowHeight = 30

	'文字を縮小して表示
    xlSheet.Range(xlSheet.Cells(1, 1), xlSheet.Cells(i - 1, 3)).ShrinkToFit = True

	'文字を折り返して表示
    xlSheet.Range(xlSheet.Cells(1, 7), xlSheet.Cells(i - 1, 2)).WrapText = True

	'文字位置の縦の中央揃え
    xlSheet.Range("A:A").VerticalAlignment = -4108
    xlSheet.Range("B:B").VerticalAlignment = -4108
    xlSheet.Range("C:C").VerticalAlignment = -4108

	'ヘッダー、フッターの記入
    With xlSheet.PageSetup
        .Orientation = 2
        .CenterHeader = "&12&B" & " ヘッダータイトルを記入 " & "&12&B&U"
        .RightHeader = Now().Year & "年" & Now.Month & "月" & Now.Day & "日"
        '.LeftFooter = ""
        .CenterFooter = "&P / &N ページ"
        '.RightFooter = ""
        .Zoom = 100
    End With

    '改ページプレビューで表示し、見やすい状態に
    xlWindow = xlApp.ActiveWindow
    xlWindow.View = 2
    xlSheet.PageSetup.Zoom = 100
    xlWindow.zoom = 75

	'ファイルを保存する場合
    'outfile = "保存するファイル名.xls"
    'xlBook.Close(SaveChanges:=True, Filename:=outfile)
    'xlApp.Quit() 	'EXCELを閉じる
	

    'オブジェクトの解放
    xlSheet = Nothing
    xlBook = Nothing
    xlApp = Nothing
    xlWindow = Nothing

    Me.Cursor = Cursors.Default
Catch ex As Exception
    Me.Cursor = Cursors.Default
    MsgBox(ex.Message)
End Try





このエントリーをはてなブックマークに追加