vb.net 向Excel模板中填充数据

50 阅读 0 评论 33 点赞

我是靠谱客的博主心灵美老鼠，最近开发中收集的这篇文章主要介绍vb.net 向Excel模板中填充数据，觉得挺不错的，现在分享给大家，希望可以做个参考。

概述

''' <summary>
    ''' Excelを作成
    ''' </summary>
    ''' <param name="dtHeader">Headerデータ</param>
    '''     ''' <param name="dtDetail">Detailrデータ</param>
    ''' <returns></returns>
    ''' <remarks>Excelを作成</remarks>
    Private Function Fn_SetExcel(ByRef dtHeader As DataTable, _
                                 ByRef dtDetail As DataTable, _
                                 ByVal int集計対象 As Integer, _
                                 ByVal intﾄﾞﾘﾙﾀﾞｳﾝ条件_部門 As Integer, _
                                 ByVal intﾄﾞﾘﾙﾀﾞｳﾝ条件_担当者 As Integer, _
                                ByVal str対象年月From As String, _
                                ByVal str対象年月To As String) As Boolean

        Dim xlsApp As Microsoft.Office.Interop.Excel.Application = Nothing
        Dim xlsWorkBook As Microsoft.Office.Interop.Excel.Workbook = Nothing
        Dim xlsSheet As Microsoft.Office.Interop.Excel.Worksheet = Nothing
        Dim strFileName As String = String.Empty                            '文件名
        Dim strFilePath As String = String.Empty                            '文件パース
        Dim intAddRowsCount As Integer = 0
        Dim j As Integer
        Dim bytfile() As Byte = My.Resources.売上分析

        '初期名前
        strFileName = "売上分析"
        'モデルファイル
        Dim strTemFile As String = PFn_GetAppliCtionPath() & strFileName
        Dim fs As System.IO.FileStream = New System.IO.FileStream(strTemFile, System.IO.FileMode.Create)

fs.Write(bytfile, 0, bytfile.Length)

fs.Close()

        Try
            '初期パス＝操作端末のデスクトップ
            Dim strPath As String = PFn_GetSavePath(strFileName, "", FileType.CON_XLS_FLG)

            If String.Empty.Equals(strPath) Then
                Fn_SetExcel = False
                Exit Function
            End If

            xlsApp = CType(CreateObject("Excel.Application"), Microsoft.Office.Interop.Excel.Application)
            xlsApp.Visible = False
            xlsApp.ScreenUpdating = False

            xlsWorkBook = xlsApp.Workbooks.Open(strTemFile, Nothing, True)
            xlsSheet = CType(xlsWorkBook.Sheets(1), Microsoft.Office.Interop.Excel.Worksheet)
            '【検索条件】
            '集計対象
            If int集計対象 = 0 Then
                xlsSheet.Cells(3, "B") = "予定含む"
            Else
                xlsSheet.Cells(3, "B") = "実績のみ"
            End If

            'ﾄﾞﾘﾙﾀﾞｳﾝ条件
            If intﾄﾞﾘﾙﾀﾞｳﾝ条件_部門 = 0 Then
                xlsSheet.Cells(3, "E") = "部門"
            End If

            If intﾄﾞﾘﾙﾀﾞｳﾝ条件_担当者 = 1 Then
                xlsSheet.Cells(3, "F") = "担当者"
            End If

'対象年月
xlsSheet.Cells(3, "H") = str対象年月From + "～" + str対象年月To

'【集計値】
For i As Integer = 1 To dtHeader.Rows.Count

                xlsSheet.Range(xlsSheet.Cells(8, "A"), xlsSheet.Cells(8, "J")).Copy()
                xlsSheet.Range(xlsSheet.Cells(8 + i, "A"), xlsSheet.Cells(8 + i, "J")).Insert()
                xlsSheet.Cells(8 + i, "A") = CStr(dtHeader.Rows(i - 1).Item("項目"))
                xlsSheet.Cells(8 + i, "B") = CStr(dtHeader.Rows(i - 1).Item("CD"))
                xlsSheet.Cells(8 + i, "C") = CStr(dtHeader.Rows(i - 1).Item("名称"))
                xlsSheet.Cells(8 + i, "D") = CStr(dtHeader.Rows(i - 1).Item("目標"))
                xlsSheet.Cells(8 + i, "E") = CStr(dtHeader.Rows(i - 1).Item("当年合計"))
                xlsSheet.Cells(8 + i, "F") = CStr(dtHeader.Rows(i - 1).Item("当年予定"))
                xlsSheet.Cells(8 + i, "G") = CStr(dtHeader.Rows(i - 1).Item("当年実績"))
                xlsSheet.Cells(8 + i, "H") = CStr(dtHeader.Rows(i - 1).Item("前年実績"))
                xlsSheet.Cells(8 + i, "I") = CStr(dtHeader.Rows(i - 1).Item("目標対比"))
                xlsSheet.Cells(8 + i, "J") = CStr(dtHeader.Rows(i - 1).Item("前年対比"))
            Next

j = 14 + dtHeader.Rows.Count - 1

'【明細】
For i As Integer = 1 To dtDetail.Rows.Count

                xlsSheet.Range(xlsSheet.Cells(j, "A"), xlsSheet.Cells(j, "J")).Copy()
                xlsSheet.Range(xlsSheet.Cells(j + i, "A"), xlsSheet.Cells(j + i, "J")).Insert()
                xlsSheet.Cells(j + i, "A") = CStr(dtDetail.Rows(i - 1).Item("CD"))
                xlsSheet.Cells(j + i, "B") = CStr(dtDetail.Rows(i - 1).Item("名称"))
                xlsSheet.Cells(j + i, "D") = CStr(dtDetail.Rows(i - 1).Item("目標"))
                xlsSheet.Cells(j + i, "E") = CStr(dtDetail.Rows(i - 1).Item("当年合計"))
                xlsSheet.Cells(j + i, "F") = CStr(dtDetail.Rows(i - 1).Item("当年予定"))
                xlsSheet.Cells(j + i, "G") = CStr(dtDetail.Rows(i - 1).Item("当年実績"))
                xlsSheet.Cells(j + i, "H") = CStr(dtDetail.Rows(i - 1).Item("前年実績"))
                xlsSheet.Cells(j + i, "I") = CStr(dtDetail.Rows(i - 1).Item("目標対比"))
                xlsSheet.Cells(j + i, "J") = CStr(dtDetail.Rows(i - 1).Item("前年対比"))
            Next

'空白行を削除
xlsSheet.Rows(j).Delete()

'空白行を削除
xlsSheet.Rows(8).Delete()

xlsApp.ScreenUpdating = True

Fn_SetExcel = True

            If String.Empty.Equals(strPath) Then
                Fn_SetExcel = False
            Else
                Fn_SetExcel = True
            End If
            xlsSheet = Nothing

            If Not xlsWorkBook Is Nothing Then
                Try
                    xlsWorkBook.SaveCopyAs(strPath)
                Catch exp As Exception
                    'エラーが発生した際にメッセージを表示します(MSGID:34(1=対象のファイル、2=使用中、3=保存)　を表示し、保存処理終了)
                    MsgBox("対象のファイルは使用中ために保存していません。")
                    Debug.WriteLine(exp.Message)
                    Fn_SetExcel = False
                End Try
                xlsWorkBook.Close(False)
                xlsWorkBook = Nothing
            End If

            If Not xlsApp Is Nothing Then
                xlsApp.Workbooks.Close()
                xlsApp.Quit()
                xlsApp = Nothing
            End If

            If IO.File.Exists(strTemFile) Then
                IO.File.Delete(strTemFile)
            End If

            GC.Collect()
        Catch ex As Exception
            If Not xlsApp Is Nothing Then
                xlsApp.Workbooks.Close()
                xlsApp.Quit()
                xlsApp = Nothing
            End If

            If IO.File.Exists(strTemFile) Then
                IO.File.Delete(strTemFile)
            End If

GC.Collect()

            Throw ex
        End Try
    End Function