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

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

###source
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

wakatta 記法

このコンテンツを見る