EMP表の一覧Excelファイルをひな形となるExcelファイルから新規作成
(オーバーレイ)

オーバーレイ機能

レイアウトや装飾を施したひな形Excelファイルを用意しておき、そこに埋め込んでゆく事でファイルを作成します。

Excelのフォーマットなんかは、ちょこちょこ変更要求が出るものです。
ひな形ファイルだけ変更すればいい事が多いので非常に重宝しています。

サンプルプログラム

ODP.NETを利用して、EMP表の一覧Excelファイルを作成します。
ただEMP表のデフォルト行数は少なくてつまらないので、同じ定義のEMPTESTを作成し、10,000行をセットしました。

ひな形となるExcelファイルを用意します
ひな形Excelファイル
**TITLE などアスタリスクが2個ついたセルがあります。ExcelCreatorではアスタリスク2個から始まるものを変数として扱う事が出来ます。プログラムからはこの変数がついたセルに直接アクセス出来ます。(デフォルトでアスタリスク2個ですが、ExcelCreator.KeyWordプロパティを変更すれば変更可能です)

  Const cmdSelect As String = _
                   "select " & _
                   "EMPNO, ENAME, JOB, NVL(MGR,0) MGR, HIREDATE, " & _
                   "NVL(SAL,0) SAL, NVL(COMM,0) COMM, DEPTNO " & _
                   "from EMPTEST " & _
                   "order by EMPNO"

        Dim i As Integer
        Dim dt As New DataTable
        Dim xlsRowNo As Integer = 0     'Excelファイルの行位置
        Dim xlsDtlStratRow As Integer = 0
        Dim xlsColST As Integer = 0
        Dim xlsColEnd As Integer = 0
        Dim xlsColPos_SAL As Integer = 0
        Dim DataCount As Integer = 0
        Dim drow As DataRow
        Dim BackColorSW As Boolean = False
        Dim TotalSAL As Decimal = 0D
        Dim TotalSALWarimasi As Decimal = 0D

        Try
            Dim strTimeStart As String = DateTime.Now.ToString '開始時刻

            Using da As New OracleDataAdapter(cmdSelect, ConnectionString)
                da.Fill(dt)

                If dt.Rows.Count > 0 Then
                    '===================================================================
                    'Excel作成
                    '===================================================================
                    'ブックオープン
                    xlsCR.OpenBook("EMP_LIST_OVERLAY.xls", "EMP_LIST_BASE.xls")
                    'シート選択
                    xlsCR.SheetNo = 0
                    'シート名の設定
                    xlsCR.SheetName = "EMPLIST"

                    '-------------------------------------------------------------------
                    '明細行開始位置を取得しておく
                    '-------------------------------------------------------------------
                    xlsDtlStratRow = xlsCR.GetVarNamePos("**EMPNO", 0).Height
                    xlsRowNo = xlsDtlStratRow + 1
                    xlsColST = xlsCR.GetVarNamePos("**EMPNO", 0).Width
                    xlsColEnd = xlsCR.GetVarNamePos("**HD_SAL_CALC", 0).Width

                    Dim LetterOfSAL As String = ConvertToLetter(xlsCR.GetVarNamePos("**HD_SAL", 0).Width + 1)
                    Dim LetterOfSAL2 As String = ConvertToLetter(xlsCR.GetVarNamePos("**HD_SAL_CALC", 0).Width + 1)

                    '-------------------------------------------------------------------
                    '見出し出力
                    '-------------------------------------------------------------------
                    xlsCR.Cell("**TITLE").Str = "EMP LIST"
                    xlsCR.Cell("**HD_EMPNO").Str = dt.Columns(0).ColumnName.TrimEnd
                    xlsCR.Cell("**HD_ENAME").Str = dt.Columns(1).ColumnName.TrimEnd
                    xlsCR.Cell("**HD_JOB").Str = dt.Columns(2).ColumnName.TrimEnd
                    xlsCR.Cell("**HD_MGR").Str = dt.Columns(3).ColumnName.TrimEnd
                    xlsCR.Cell("**HD_HIREDATE").Str = dt.Columns(4).ColumnName.TrimEnd
                    xlsCR.Cell("**HD_SAL").Str = dt.Columns(5).ColumnName.TrimEnd
                    xlsCR.Cell("**HD_COMM").Str = dt.Columns(6).ColumnName.TrimEnd
                    xlsCR.Cell("**HD_DEPTNO").Str = dt.Columns(7).ColumnName.TrimEnd
                    xlsCR.Cell("**HD_SAL_CALC").Str = "SALの2割増金額"

                    '-------------------------------------------------------------------
                    '行出力
                    '-------------------------------------------------------------------
                    For i = 0 To dt.Rows.Count - 1
                        drow = dt.Rows(i)

                        xlsCR.Cell("**EMPNO", 0, i).Long = CInt(drow.Item("EMPNO"))
                        xlsCR.Cell("**ENAME", 0, i).Str = drow.Item("ENAME").ToString.TrimEnd
                        xlsCR.Cell("**JOB", 0, i).Str = drow.Item("JOB").ToString.TrimEnd
                        xlsCR.Cell("**MGR", 0, i).Long = CInt(drow.Item("MGR"))
                        xlsCR.Cell("**HIREDATE", 0, i).Value = drow.Item("HIREDATE")
                        xlsCR.Cell("**HIREDATE", 0, i).Attr.Format = "yyyy/m/d"
                        xlsCR.Cell("**SAL", 0, i).Double = CDec(drow.Item("SAL"))
                        xlsCR.Cell("**COMM", 0, i).Double = CDec(drow.Item("COMM"))
                        xlsCR.Cell("**DEPTNO", 0, i).Long = CInt(drow.Item("DEPTNO"))
                        '計算式セット
                        Dim SALCALC_FUNC As String = "=" & LetterOfSAL & (xlsDtlStratRow + i + 1).ToString & " * 1.2"
                        xlsCR.Cell("**SAL_CALC", 0, i).Func(SALCALC_FUNC, CDec(drow.Item("SAL")) * 1.2)
                        xlsCR.Cell("**SAL_CALC", 0, i).Attr.Format = "#,###,###,##0.00"

                        '背景色を1行おきに変える
                        If BackColorSW Then
                            xlsCR.Pos(xlsColST, xlsRowNo - 1, xlsColEnd, xlsRowNo - 1).Attr.BackColor = _
                                        CType(26, ExcelCreator.xlColor)
                        End If
                        BackColorSW = Not BackColorSW

                        '合計項目の加算
                        TotalSAL += CDec(drow.Item("SAL"))
                        TotalSALWarimasi = TotalSALWarimasi + CDec(drow.Item("SAL")) * 1.2D

                        xlsRowNo = xlsRowNo + 1
                        DataCount += 1
                    Next

                    '-------------------------------------------------------------------
                    '合計行(SALの合計・SALの2割り増し金額)
                    '-------------------------------------------------------------------
                    xlsCR.Cell("**HD_EMPNO", 0, DataCount + 1).Str = "**合計**"
                    xlsCR.Cell("**HD_SAL", 0, DataCount + 1).Func("=sum(" & LetterOfSAL & (xlsDtlStratRow + 1).ToString & ":" & _
                                                        LetterOfSAL & (xlsDtlStratRow + DataCount).ToString & ")", TotalSAL)
                    xlsCR.Cell("**HD_SAL_CALC", 0, DataCount + 1).Func("=sum(" & LetterOfSAL2 & (xlsDtlStratRow + 1).ToString & ":" & _
                                                      LetterOfSAL2 & (xlsDtlStratRow + DataCount).ToString & ")", TotalSALWarimasi)
                    '背景色変更:オレンジ
                    xlsCR.Pos(xlsColST, xlsRowNo - 1, xlsColEnd, xlsRowNo - 1).Attr.BackColor = CType(53, ExcelCreator.xlColor)
                    'Format カンマ
                    xlsCR.Cell("**HD_SAL", 0, DataCount + 1).Attr.Format = "#,###,###,##0"
                    xlsCR.Cell("**HD_SAL_CALC", 0, DataCount + 1).Attr.Format = "#,###,###,##0.00"
                    '行の高さを20ポイントにする
                    xlsCR.Pos(xlsColST, xlsRowNo - 1).RowHeight = 20


                    '-------------------------------------------------------------------
                    '罫線
                    '-------------------------------------------------------------------
                    xlsCR.Pos(xlsColST, xlsDtlStratRow, xlsColEnd, xlsRowNo - 1).Attr.LineBottom = ExcelCreator.xlLineStyle.lsNormal
                    xlsCR.Pos(xlsColST, xlsDtlStratRow, xlsColEnd, xlsRowNo - 1).Attr.LineRight = ExcelCreator.xlLineStyle.lsNormal
                    xlsCR.Pos(xlsColST, xlsDtlStratRow, xlsColST, xlsRowNo - 1).Attr.LineLeft = ExcelCreator.xlLineStyle.lsNormal

                    ' クローズ
                    xlsCR.CloseBook(True)

                    Dim strTimeEnd As String = DateTime.Now.ToString '終了時刻
                    MessageBox.Show("EMP_LIST_OVERLAY.xls を作成しました。" & vbCrLf & strTimeStart & "~" & strTimeEnd, "完了")

                    ' 作成した Excel ファイルを開く(実行環境に Excel がある場合のみ)
                    If IsNothing(Type.GetTypeFromProgID("Excel.Application")) Then
                        ' 実行環境に Excel がない場合、完了メッセージのみ
                        MessageBox.Show("EMP_LIST.xls を作成しました。", "作成完了")
                    Else
                        Dim dlg As DialogResult
                        dlg = MessageBox.Show( _
                                "EMP_LIST.xls を作成しました。" & vbCrLf & _
                                "作成した Excel ファイルを開きますか?", _
                                "完了", MessageBoxButtons.YesNo)

                        If dlg = DialogResult.Yes Then
                            ' Excel ファイル起動
                            Dim prFile As System.Diagnostics.Process
                            prFile = New System.Diagnostics.Process()
                            prFile = System.Diagnostics.Process.Start("EMP_LIST_OVERLAY.xls")
                        End If
                    End If
                End If
            End Using

        Catch ex As Exception
            MessageBox.Show(ex.Message, "例外エラー", MessageBoxButtons.OK, MessageBoxIcon.Error)
        Finally
            If Not IsNothing(dt) Then
                dt.Dispose()
            End If

        End Try
		
	''' 
    ''' Excelの列番号を英文字に変換する
    ''' 
    ''' 列番号
    ''' 
    ''' 
    ''' マイクロソフトサポートオンラインより引用して変更を加えた
    ''' http://support.microsoft.com/kb/833402/ja
    ''' 
    Function ConvertToLetter(ByVal iCol As Integer) As String
        Dim rtnLetter As String = ""
        Dim iAlpha As Integer
        Dim iRemainder As Integer

        iAlpha = CInt(Int((iCol - 1) / 26))
        iRemainder = iCol - (iAlpha * 26)
        If iAlpha > 0 Then
            rtnLetter = Chr(iAlpha + 64)
        End If
        If iRemainder > 0 Then
            rtnLetter = rtnLetter & Chr(iRemainder + 64)
        End If
        Return rtnLetter

    End Function
	

コードの説明

  • Line78 : 行内の計算式(SALの2割増金額)をセットしています。

    Func メソッドで計算結果をあらかじめ設定することで、ExcelCreatorで作成したExcelファイルをExcelで開いたとき、修正を行わずに終了した時に表示される保存の確認メッセージを非表示にできます。
    設定しない場合、何にも変更していなくても終了時に保存確認のメッセージが表示されます。ヒジョーに鬱陶しいです

  • Line84 : ちょっとおしゃれして背景色を1行おきに変えています。
  • Line101 - 112 : 合計行を追加してみました。
  • Line118 - 120 : 罫線を追加しています
  • Line167 - 182 : ConvertToLetter関数

    Excelの列番号から英文字を取得する関数です。(マイクロソフトサポートオンラインより引用し編集)
    FUNCメソッドを利用する際使っています

作成されたExcelファイル


 

修正履歴

Loading