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

vb.net 向Excel模板中填充数据,第1张

概述  ''' <summary>     ''' Excelを作成     ''' </summary>     ''' <param name="dtHeader">Headerデータ</param>     '''     ''' <param name="dtDetail">Detailrデータ</param>     ''' <returns></returns>     ''' <rema

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

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.売上分析@H_419_14@

'初期名前
strfilename = "売上分析"
'モデルファイル
Dim strTemfile As String = PFn_GetAppliCtionPath() & strfilename
Dim fs As System.IO.fileStream = New System.IO.fileStream(strTemfile,System.IO.fileMode.Create)@H_419_14@

fs.Write(bytfile,bytfile.Length)@H_419_14@

fs.Close()@H_419_14@

Try
'初期パス= *** 作端末のデスクトップ
Dim strPath As String = PFn_GetSavePath(strfilename,"",fileType.CON_XLS_FLG)@H_419_14@

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

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

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@H_419_14@

'ドリルダウン条件
If intドリルダウン条件_部門 = 0 Then
xlsSheet.Cells(3,"E") = "部門"
End If@H_419_14@

If intドリルダウン条件_担当者 = 1 Then
xlsSheet.Cells(3,"F") = "担当者"
End If@H_419_14@

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

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

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@H_419_14@

j = 14 + dtheader.Rows.Count - 1@H_419_14@

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

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@H_419_14@

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

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

xlsApp.ScreenUpdating = True@H_419_14@

Fn_SetExcel = True@H_419_14@

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

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@H_419_14@

If Not xlsApp Is nothing Then
xlsApp.Workbooks.Close()
xlsApp.Quit()
xlsApp = nothing
End If@H_419_14@

If IO.file.Exists(strTemfile) Then
IO.file.Delete(strTemfile)
End If@H_419_14@

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

If IO.file.Exists(strTemfile) Then
IO.file.Delete(strTemfile)
End If@H_419_14@

GC.Collect()@H_419_14@

Throw ex End Try End Function@H_419_14@ 总结

以上是内存溢出为你收集整理的vb.net 向Excel模板填充数据全部内容,希望文章能够帮你解决vb.net 向Excel模板中填充数据所遇到的程序开发问题。

如果觉得内存溢出网站内容还不错,欢迎将内存溢出网站推荐给程序员好友。

欢迎分享,转载请注明来源:内存溢出

原文地址: http://outofmemory.cn/langs/1285805.html

(0)
打赏 微信扫一扫 微信扫一扫 支付宝扫一扫 支付宝扫一扫
上一篇 2022-06-09
下一篇 2022-06-09

发表评论

登录后才能评论

评论列表(0条)

保存