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

阳光穿透心脏的1/2处 2022-06-12 12:00 352阅读 0赞

''' <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