PGlabo

« [VB.NET] Tab遷移をEnterで | メイン | [VB.NET] 日付の存在チェック »

2005年12月16日

[VB.NET] Excelの操作

        'Excel設定値
        Const xlLandscape = 2           '用紙向き　横
        Const xlCenter = -4108          '中央揃え
        Const xlRight = -4152           '右揃え
        Const xlLeft = -4131            '左揃え
        Const xlInsideHorizontal = 12
        Const xlContinuous = 1
        Const xlThin = 2

        'Excel列番号

        Const cnsCol1 As Integer = 1

        Const cnsCol2 As Integer = 2

        Const cnsCol3 As Integer = 3

        'Excel保存先

        Const FilePath As String = "C:\Excel\Test.xls"

        'Excelオブジェクト

        Dim oExcel As Object        'Excel.Application

        Dim oBooks As Object        'Excel.Workbooks 

        Dim oBook As Object         'Excel.Workbook 

        Dim oSheets As Object       'Excel.Sheets 

        Dim oSheet As Object        'Excel.Worksheet 

        Dim oRange As Object        'Excel.Range

        Dim oCells As Object        'Excel.Range（１回の解放でOK）

        Dim oBorders As Object      'Excel.Borders

        Dim oPageSetup As Object    'Excel.PageSetup

        Dim GridData(,) As String

        Dim intRow As Integer

        Dim intRowCount As Integer

        Try

            'Excelオブジェクトセット

            oExcel = CreateObject("Excel.Application")

            oBooks = oExcel.Workbooks

            oBook = oBooks.Add

            oSheets = oBook.Worksheets

            oSheet = oSheets(1)

            oCells = oSheet.Cells

            '----- １行目 -----

            intRow = 1

            '列幅設定

            oRange = oCells(intRow, cnsCol1)

            oRange.ColumnWidth = 10.25

            Call MRComObject(oRange)

            oRange = oCells(intRow, cnsCol2)

            oRange.ColumnWidth = 10.25

            Call MRComObject(oRange)

            oRange = oCells(intRow, cnsCol3)

            oRange.ColumnWidth = 10.25

            Call MRComObject(oRange)

            '列タイトル 中央揃え

            oRange = oSheet.Range(R1C1ToA1(intRow, cnsCol1, intRow, cnsCol3))

            With oRange

                .HorizontalAlignment = xlCenter

                .VerticalAlignment = xlCenter

            End With

            Call MRComObject(oRange)

            '列タイトル 表示

            oCells(intRow, cnsCol1) = "列名１"

            oCells(intRow, cnsCol2) = "列名２"

            oCells(intRow, cnsCol3) = "列名３"

            '----- ２行目以降 -----

            intRow += 1

            'データを表示する

            ReDim GridData(1, 2)

            GridData(0, 0) = "A1" : GridData(0, 1) = "B1" : GridData(0, 2) = "C1"

            GridData(1, 0) = "A2" : GridData(1, 1) = "B2" : GridData(1, 2) = "C2"

            oRange = oSheet.Range(R1C1ToA1(intRow, cnsCol1, intRow + 1, cnsCol3))

            oRange.value = GridData

            Call MRComObject(oRange)

            '罫線を引く

            oRange = oSheet.Range(R1C1ToA1(1, cnsCol1, GridDataNum + 1, cnsCol3))

            oBorders = oRange.borders(xlInsideHorizontal) '横線

            With oBorders

                oBorders.LineStyle = xlContinuous

                oBorders.Weight = xlThin

            End With

            Call MRComObject(oBorders)

            Call MRComObject(oRange)

            'ページヘッダ部設定

            oPageSetup = oSheet.PageSetup

            With oPageSetup

                .LeftHeader = ""

                .CenterHeader = "&20 入出庫履歴"

                .RightHeader = "&10" & "日付  &D" & " 現在"

                .Orientation = xlLandscape

                .ZOOM = 75

                .LeftMargin = 0

                .RightMargin = 0

            End With

            Call MRComObject(oPageSetup)

            'Excelを保存する

            oExcel.DisplayAlerts = False    '警告メッセージ非表示

            oBook.SaveAs(FilePath)          'Excel保存

            oExcel.DisplayAlerts = True     '警告メッセージ表示



        Catch ex As Exception

            MsgBox(Err.Description)

        Finally

            'Excelオブジェクトの解放

            Call MRComObject(oCells)    'oCells の解放

            Call MRComObject(oSheet)    'oSheet の解放

            Call MRComObject(oSheets)   'oSheets の解放

            oBook.Close(False)          'oBook を閉じる

            Call MRComObject(oBook)     'oBook の解放

            Call MRComObject(oBooks)    'oBooks の解放

            oExcel.Quit()               'oExcelを閉じる 

            Call MRComObject(oExcel)    'oExcel を解放

            GC.Collect() 'ガーベジコレクト起動

            '-----------------------------------------------------------

            'Excelプロセスチェック

            System.Threading.Thread.Sleep(1000)

            Dim localByName As Process() = Process.GetProcessesByName("Excel")

            If localByName.Length > 0 Then

                MessageBox.Show("まだ Excel.EXE が " & localByName.Length & " 個 起動しています。")

            Else

                MessageBox.Show("起動している Excel.EXE はありません。")

            End If

            '-----------------------------------------------------------

        End Try

    '***** R1C1形式のアドレスをA1形式に変換する *****
    Private Function R1C1ToA1( _
        ByVal R1 As Integer, _
        ByVal C1 As Integer, _
        ByVal R2 As Integer, _
        ByVal C2 As Integer) As String

        Try

            Dim i1, i2 As Integer

            Dim d1, d2 As String

            i1 = Math.Floor((C1 - 1) \ 26)

            d1 = IIf(C1 > 26, Strings.Chr(64 + i1), "")

            i1 = C1 - 26 * i1

            d1 &= Strings.Chr(64 + i1) & CStr(R1)

            i2 = Math.Floor((C2 - 1) \ 26)

            d2 = IIf(C2 > 26, Strings.Chr(64 + i2), "")

            i2 = C2 - 26 * i2

            d2 &= Strings.Chr(64 + i2) & CStr(R2)

            Return d1 & ":" & d2

        Catch ex As Exception

            MessageBox.Show(ex.ToString)

        End Try

    End Function



    '***** COMオブジェクトへの参照を解放する *****

    Private Sub MRComObject(ByRef ComObject As Object)

        Try

            '提供されたランタイム呼び出し可能ラッパーの参照カウントをデクリメントする

            System.Runtime.InteropServices.Marshal.ReleaseComObject(ComObject)

        Catch

        Finally

            '参照を解除する

            ComObject = Nothing

        End Try

    End Sub

2005 / 12 / 16