''' <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,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,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,xlsSheet.Cells(j,"J")).Copy()
xlsSheet.Range(xlsSheet.Cells(j + i,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
原文链接:/vb/259993.html