Excel書き出し

Imports System.Runtime.InteropServices

''' <summary>
''' Excel書き出し
''' </summary>
''' <remarks></remarks>
Module mdlExcel

    Public Sub ps_Excel(ByVal wp_Array As Object(,), Optional ByVal wp_SheetName As String = "")
        Dim ap As Object
        Try
            ap = GetObject(, "Excel.Application")
        Catch ex As Exception
            ap = CreateObject("Excel.Application")
        End Try
        Dim wb As Object = ap.Workbooks.Add()
        Dim ws As Object = wb.Sheets(1)
        Dim w As String = ""

        '枠線を非表示
        ap.ActiveWindow.DisplayGridlines = False

        'ウィンドウ枠の固定
        If wp_Array.GetLength(0) > 1 Then
            w = "2:2"
            ws.Rows(w).Select()
            ap.ActiveWindow.FreezePanes = True
        End If

        '値の貼り付け
        w = mf_A1(1, 1, wp_Array.GetLength(0), wp_Array.GetLength(1))
        ws.Range(w) = wp_Array

        '罫線の描画
        ws.Range(w).Borders(7).LineStyle = 1
        ws.Range(w).Borders(7).ColorIndex = 1
        ws.Range(w).Borders(8).LineStyle = 1
        ws.Range(w).Borders(8).ColorIndex = 1
        ws.Range(w).Borders(9).LineStyle = 1
        ws.Range(w).Borders(9).ColorIndex = 1
        ws.Range(w).Borders(10).LineStyle = 1
        ws.Range(w).Borders(10).ColorIndex = 1
        If wp_Array.GetLength(1) > 1 Then
            ws.Range(w).Borders(11).LineStyle = 1
            ws.Range(w).Borders(11).ColorIndex = 1
        End If
        If wp_Array.GetLength(0) > 1 Then
            ws.Range(w).Borders(12).LineStyle = 1
            ws.Range(w).Borders(12).ColorIndex = 1
        End If

        '列表題のセンタリングと背景色の設定
        If wp_Array.GetLength(0) > 1 Then
            w = mf_A1(1, 1, 1, wp_Array.GetLength(1))
            ws.Range(w).HorizontalAlignment = -4108
            ws.Range(w).VerticalAlignment = -4107
            ws.Range(w).Interior.ThemeColor = 9
            ws.Range(w).Interior.TintAndShade = 0.799981688894314
        End If

        '列幅の自動設定
        w = String.Format("{0}:{1}", mf_A1(1), mf_A1(wp_Array.GetLength(1)))
        ws.Columns(w).EntireColumn.AutoFit()

        'カーソルの移動
        w = mf_A1(1, 1)
        ws.Range(w).Select()

        'シート名の設定
        Try
            If wp_SheetName <> "" Then
                ws.Name = wp_SheetName
            End If
        Catch ex As Exception
        End Try

        'Excelの表示
        ap.Visible = True

        'ページ設定
        Try
            ap.PrintCommunication = False
            'タイトル行
            ws.PageSetup.PrintTitleRows = "$1:$1"
            '左余白(2)
            ws.PageSetup.LeftMargin = ap.InchesToPoints(0.78740157480315)
            '右余白(1)
            ws.PageSetup.RightMargin = ap.InchesToPoints(0.393700787401575)
            '上余白(2)
            ws.PageSetup.TopMargin = ap.InchesToPoints(0.78740157480315)
            '下余白(2)
            ws.PageSetup.BottomMargin = ap.InchesToPoints(0.78740157480315)
            'ヘッダ余白(1)
            ws.PageSetup.HeaderMargin = ap.InchesToPoints(0.393700787401575)
            'フッタ余白(1)
            ws.PageSetup.FooterMargin = ap.InchesToPoints(0.393700787401575)
            '用紙方向(縦)
            Dim xlPortrait As Integer = 1   '縦
            Dim xlLandscape As Integer = 2  '横
            ws.PageSetup.Orientation = xlPortrait
            'ws.PageSetup.Orientation = xlLandscape
            '用紙サイズ(A4)
            Dim xlPaperA4 As Integer = 9    'A4
            Dim xlPaperA3 As Integer = 8    'A3
            ws.PageSetup.PaperSize = xlPaperA4
            'ws.PageSetup.PaperSize = xlPaperA3
            '自動サイズ調整(横1x縦Null)
            ws.PageSetup.FitToPagesWide = 1
            ws.PageSetup.FitToPagesTall = False
            ap.PrintCommunication = True

            ap.PrintCommunication = False
            'ヘッダ中央部(シート名)
            ws.PageSetup.CenterHeader = "&A"
            ap.PrintCommunication = True

            ap.PrintCommunication = False
            'ヘッダ右側(作成日<LF>作成者)
            Dim w_RightHeader As String = String.Format("{0}{1}{2}", Now.ToString("yyyy.MM.dd"), vbLf, "NMHIS中川雅隆")
            ws.PageSetup.RightHeader = w_RightHeader
            ap.PrintCommunication = True

            ap.PrintCommunication = False
            'フッタ中央部(ページ番号/総ページ数)
            ws.PageSetup.CenterFooter = "&P/&N"
            ap.PrintCommunication = True

        Catch ex As Exception
            MsgBox(ex.Message, MsgBoxStyle.SystemModal)
        End Try

        'Excelをアクティブにする
        Try
            Dim w_Title As String = ap.Caption.ToString
            AppActivate(w_Title)
        Catch ex As Exception
        End Try

        'オブジェクトの解放
        Marshal.ReleaseComObject(ws)
        Marshal.ReleaseComObject(wb)
        Marshal.ReleaseComObject(ap)
        ws = Nothing
        wb = Nothing
        ap = Nothing
    End Sub

    Private Function mf_A1(wp_Col As Integer) As String
        Dim ret As String = ""
        Dim w As String = "ABCDEFGHIJKLMNOPQRSTUVWXYZ"
        Dim i1 As Integer = CInt(Math.Floor((wp_Col - 1) / 26))
        Dim i2 As Integer = (wp_Col - 1) Mod 26
        If i1 = 0 Then
            ret = w.Substring(i2, 1)
        Else
            ret = String.Format("{0}{1}", w.Substring(i1 - 1, 1), w.Substring(i2, 1))
        End If
        Return ret
    End Function

    Private Function mf_A1(wp_Row As Integer, wp_Col As Integer) As String
        Dim ret As String = String.Format("{0}{1}", mf_A1(wp_Col), wp_Row)
        Return ret
    End Function

    Private Function mf_A1(wp_Row1 As Integer, wp_Col1 As Integer, wp_Row2 As Integer, wp_Col2 As Integer) As String
        Dim ret As String = String.Format("{0}:{1}", mf_A1(wp_Row1, wp_Col1), mf_A1(wp_Row2, wp_Col2))
        Return ret
    End Function

End Module