Excel Helper 源代码(VB.NET)

自己写了一个对Excel操作的类， 封装了Excel的通常的操作，以简化生成 Excel 报表的代码量。

代码基于 .net 2.0， Excel 2003

该 Assembly 共有两个类：

1. XlsReport.vb

ImportsSystem
ImportsExcel=Microsoft.Office.Interop.Excel

PublicEnumXlCopyActionEnumXlCopyAction
Paste
Insert
EndEnum

PublicEnumXlBordersEnumXlBorders
xlDiagonalDown=Excel.XlBordersIndex.xlDiagonalDown
xlDiagonalUp=Excel.XlBordersIndex.xlDiagonalUp
xlEdgeLeft=Excel.XlBordersIndex.xlEdgeLeft
xlEdgeTop=Excel.XlBordersIndex.xlEdgeTop
xlEdgeBottom=Excel.XlBordersIndex.xlEdgeBottom
xlEdgeRigth=Excel.XlBordersIndex.xlEdgeRight
xlInsideHorizontal=Excel.XlBordersIndex.xlInsideHorizontal
xlInsideVertical=Excel.XlBordersIndex.xlInsideVertical
EndEnum

PublicEnumXlLineStyleEnumXlLineStyle
xlContinuous=Excel.XlLineStyle.xlContinuous
xlDash=Excel.XlLineStyle.xlDash
xlDashDot=Excel.XlLineStyle.xlDashDot
xlDashDotDot=Excel.XlLineStyle.xlDashDotDot
xlDot=Excel.XlLineStyle.xlDot
xlDouble=Excel.XlLineStyle.xlDouble
xlLineStyleNone=Excel.XlLineStyle.xlLineStyleNone
xlSlantDashDot=Excel.XlLineStyle.xlSlantDashDot
EndEnum

PublicEnumXlBorderWightEnumXlBorderWight
xlHairline=Excel.XlBorderWeight.xlHairline
xlMedium=Excel.XlBorderWeight.xlMedium
xlThick=Excel.XlBorderWeight.xlThick
xlThin=Excel.XlBorderWeight.xlThin
EndEnum

PublicEnumXlFontStyleEnumXlFontStyle
xlStrikethrough
xlSuperscript
xlSubscript
xlOutlineFont
xlShadow
xlBold
xlItalic
xlUnderlineDouble
xlUnderlineSingle
xlNone
EndEnum

PublicEnumXlCellFormatEnumXlCellFormat
xlWrapTest
xlShrinkToFit
xlNone
EndEnum

PublicEnumXlHAlignEnumXlHAlign
xlCenter=Excel.XlHAlign.xlHAlignCenter
xlCenterAcrossSelection=Excel.XlHAlign.xlHAlignCenterAcrossSelection
xlDistributed=Excel.XlHAlign.xlHAlignDistributed
xlFill=Excel.XlHAlign.xlHAlignFill
xlGeneral=Excel.XlHAlign.xlHAlignGeneral
xlJustify=Excel.XlHAlign.xlHAlignJustify
xlLeft=Excel.XlHAlign.xlHAlignLeft
xlRight=Excel.XlHAlign.xlHAlignRight
EndEnum

PublicEnumXlVAlignEnumXlVAlign
xlBottom=Excel.XlVAlign.xlVAlignBottom
xlCenter=Excel.XlVAlign.xlVAlignCenter
xlDistributed=Excel.XlVAlign.xlVAlignDistributed
xlJustify=Excel.XlVAlign.xlVAlignJustify
xlTop=Excel.XlVAlign.xlVAlignTop
EndEnum

PublicEnumXlFillPatternEnumXlFillPattern
xlNone=Excel.XlPattern.xlPatternNone
xlSolid=Excel.XlPattern.xlPatternSolid
xlAuto=Excel.XlPattern.xlPatternAutomatic
xlChecker=Excel.XlPattern.xlPatternChecker
xlCrissCross=Excel.XlPattern.xlPatternCrissCross
xlDown=Excel.XlPattern.xlPatternDown
xlUp=Excel.XlPattern.xlPatternUp
xlHorizontal=Excel.XlPattern.xlPatternHorizontal
xlVertical=Excel.XlPattern.xlPatternVertical
xlGrid=Excel.XlPattern.xlPatternGrid
xlGray8=Excel.XlPattern.xlPatternGray8
xlGray16=Excel.XlPattern.xlPatternGray16
xlGray25=Excel.XlPattern.xlPatternGray25
xlGray50=Excel.XlPattern.xlPatternGray50
xlGray75=Excel.XlPattern.xlPatternGray75
xlLightDown=Excel.XlPattern.xlPatternLightDown
xlLightHorizontal=Excel.XlPattern.xlPatternLightHorizontal
xlLightUp=Excel.XlPattern.xlPatternLightUp
xlLightVertical=Excel.XlPattern.xlPatternLightVertical
xlSemiGray75=Excel.XlPattern.xlPatternSemiGray75
EndEnum

PublicClassXlsReportClassXlsReport

プロパティ#Region"プロパティ"

PrivatemxlsAppAsExcel.ApplicationClass'Excelオブジェクト
PrivatemxbkBookAsExcel._Workbook'表テンプレートとするExcelワークブック
PrivatemxstSheetAsExcel._Worksheet'表テンプレートとするExcelワークシート
PrivatemxstTmplSheetAsExcel._Worksheet'テンプレートワークシート
PrivatemstrKeyWordAsString="**"'変数名の先頭キーワード文字列
PrivatemhtKeyCellContainerAsHashtable'セルのHash
PrivatemlstTmplSheetNameAsList(OfString)'テンプレートワークシート名のリスト
PrivatemblnIsWorkbookClosedAsBoolean

'*====================================================================================================
'*
'*[PROPERTY]
'*変数名の先頭キーワード文字列を設定する。IN
'*
'*====================================================================================================
PublicWriteOnlyPropertyKeyWord()PropertyKeyWord()AsString
Set(ByValvalueAsString)
mstrKeyWord=value
EndSet
EndProperty

'*====================================================================================================
'*
'*[PROPERTY]
'*Excelワークシートを設定するIO
'*
'*====================================================================================================
PublicPropertyActiveSheet()PropertyActiveSheet()AsString
Get
ReturnmxstSheet.Name
EndGet
Set(ByValValueAsString)
Try
mxstSheet=CType(mxbkBook.Worksheets(Value),Excel.Worksheet)
CatchexAsException
ThrowNewXlsReportException(ex,XlErrorNo.errSheet)
EndTry
EndSet
EndProperty

#EndRegion

Reportの操作#Region"Reportの操作"

'*====================================================================================================
'*
'*[PROCEDURE]
'*clsWorkSheetのインスタンスを初期化する
'*
'*[ARGUMENT]
'*strFilePathIN　要求経路
'*strPasswdIN要求パスワード
'*
'*====================================================================================================
PublicSubNew()SubNew(ByValstrFilePathAsString,OptionalByValstrPasswdAsString=Nothing)
Try
Me.mxlsApp=NewExcel.ApplicationClass
Me.mxlsApp.Visible=False
Me.mxbkBook=Me.mxlsApp.Workbooks.Open(strFilePath,Password:=strPasswd)
Me.mxstSheet=mxbkBook.Worksheets(1)
Me.mxstTmplSheet=mxstSheet
Me.mhtKeyCellContainer=NewHashtable()
Me.mlstTmplSheetName=NewList(OfString)
Me.mblnIsWorkbookClosed=False
CatchexAsException
Me.Dispose()
ThrowNewXlsReportException(ex,XlErrorNo.errOpen)
EndTry
EndSub

'*====================================================================================================
'*
'*[PROCEDURE]
'*ワークシートを添加する
'*
'*[ARGUMENT]
'*strTemplateSheetNameIN　　要求Excelテンプレートワークシート名
'*strNewSheetNameIN添加のワークシートの名
'*
'*====================================================================================================
PublicSubSheetAdd()SubSheetAdd(ByValstrTemplateSheetNameAsString,OptionalByValstrNewSheetNameAsString="")
Try
Me.mxstTmplSheet=Me.mxbkBook.Worksheets(strTemplateSheetName)
IfmlstTmplSheetName.IndexOf(strTemplateSheetName)<0Then
mlstTmplSheetName.Add(strTemplateSheetName)
EndIf
Me.mxstTmplSheet.Copy(After:=Me.mxstSheet)
mxstSheet=mxbkBook.ActiveSheet
IfstrNewSheetName<>""Then
mxstSheet.Name=strNewSheetName
EndIf
CatchexAsException
ThrowNewXlsReportException(ex,XlErrorNo.errAddSheet)
EndTry
EndSub

'*====================================================================================================
'*
'*[PROCEDURE]
'*Excelシート保存
'*
'*[ARGUMENT]
'*strXlsPathIN要求保存経路
'*strPasswdIN要求パスワード
'*
'*====================================================================================================
PublicSubSaveAs()SubSaveAs(ByValstrXlsPathAsString,OptionalByValstrPasswdAsString=Nothing)
Try
'保存するファイル形式が「.xls」でなければエラーとする
IfStrConv(Microsoft.VisualBasic.Right(strXlsPath,4),VbStrConv.Lowercase)<>".xls"Then
Return
EndIf
'保存時の確認メッセージを表示しないように変更
mxlsApp.DisplayAlerts=False
'テンプレートワークシートを削除する
ForEachstrSheetNameAsStringInmlstTmplSheetName
CType(Me.mxbkBook.Worksheets(strSheetName),Excel._Worksheet).Delete()
Next
mxbkBook.Password=strPasswd
'ワークシートをExcel形式で保存する
mxbkBook.SaveAs(Filename:=strXlsPath,FileFormat:=Excel.XlFileFormat.xlWorkbookNormal,_
ReadOnlyRecommended:=False,CreateBackup:=False)
mxbkBook.Close()
mblnIsWorkbookClosed=True
'保存時の確認メッセージを表示するように変更
mxlsApp.DisplayAlerts=True
CatchexAsException
ThrowNewXlsReportException(ex,XlErrorNo.errSave)
EndTry
EndSub

''*====================================================================================================
''*
''*[PROCEDURE]
''*ワークブックを閉じる。True--保存,False--保存ない
''*
''*[ARGUMENT]
''*blnSaveIN要求True、False
''*
''*====================================================================================================
'PublicSubClose(OptionalByValblnSaveAsBoolean=True)
'Try
''保存時の確認メッセージを表示しないように変更
'mxlsApp.DisplayAlerts=False
'IfblnSaveThen
'IfMe.mblnMultiSheetsThen
'Me.mxstTmplSheet.Visible=Excel.XlSheetVisibility.xlSheetHidden
'EndIf
'Me.mxbkBook.Close(SaveChanges:=Excel.XlSaveAction.xlSaveChanges)
'Else
'Me.mxbkBook.Close(SaveChanges:=Excel.XlSaveAction.xlDoNotSaveChanges)
'EndIf
''保存時の確認メッセージを表示するように変更
'mxlsApp.DisplayAlerts=True
'CatchexAsException
'ThrowNewXlsReportException(ex,XlErrorNo.errClose)
'EndTry
'EndSub

'*====================================================================================================
'*
'*[PROCEDURE]
'*COMオブジェクトのすべてをリリースする
'*
'*[ARGUMENT]
'*なし
'*
'*====================================================================================================
PublicSubDispose()SubDispose()
IfmxstSheetIsNotNothingThen
System.Runtime.InteropServices.Marshal.ReleaseComObject(mxstSheet)
mxstSheet=Nothing
EndIf
IfmxstTmplSheetIsNotNothingThen
System.Runtime.InteropServices.Marshal.ReleaseComObject(mxstTmplSheet)
mxstTmplSheet=Nothing
EndIf
IfmxbkBookIsNotNothingThen
mxlsApp.DisplayAlerts=False
IfNotmblnIsWorkbookClosedThen
mxbkBook.Close()
EndIf
System.Runtime.InteropServices.Marshal.ReleaseComObject(mxbkBook)
mxbkBook=Nothing
mxlsApp.DisplayAlerts=True
EndIf
IfmxlsAppIsNotNothingThen
mxlsApp.Quit()
System.Runtime.InteropServices.Marshal.ReleaseComObject(mxlsApp)
mxlsApp=Nothing
GC.Collect()
EndIf
EndSub

#EndRegion

セルの操作#Region"セルの操作"

'*====================================================================================================
'*
'*[FUNCTION]
'*セルを取得する
'*
'*[RETURN]
'*セル
'*
'*[ARGUMENT]
'*strCellINセル名
'*
'*====================================================================================================
PrivateFunctionGetCell()FunctionGetCell(ByValstrCellAsString)AsExcel.Range
DimcellAsExcel.Range=Nothing
Try
IfstrCell.StartsWith(mstrKeyWord)Then
IfMe.mhtKeyCellContainer.Contains(strCell)Then
cell=Me.mxstSheet.Range(mhtKeyCellContainer(strCell))
Else
cell=Me.mxstSheet.Cells.Find(strCell)
Me.mhtKeyCellContainer(strCell)=cell.Address
EndIf
Else
cell=Me.mxstSheet.Range(strCell)
EndIf
CatchexAsException
EndTry
IfcellIsNothingThen
DimmsgAsString=String.Format("セル({0})ではありません。",strCell)
ThrowNewXlsReportException(Nothing,XlErrorNo.errCell,msg)
EndIf
Returncell
EndFunction

'*====================================================================================================
'*
'*[FUNCTION]
'*セルを取得する
'*
'*[RETURN]
'*セル
'*
'*[ARGUMENT]
'*intRowINセルの行(1～)
'*intColINセルの列(1～)
'*
'*====================================================================================================
PrivateFunctionGetCell()FunctionGetCell(ByValintRowAsInteger,ByValintColAsInteger)AsExcel.Range
DimcellAsExcel.Range=Nothing
Try
cell=CType(Me.mxstSheet.Cells(intRow,intCol),Excel.Range)
CatchexAsException
EndTry
IfcellIsNothingThen
DimmsgAsString=String.Format("セル({0},{1})ではありません。",intRow,intCol)
ThrowNewXlsReportException(Nothing,XlErrorNo.errCell,msg)
EndIf
Returncell
EndFunction

'*====================================================================================================
'*
'*[PROCEDURE]
'*セルに公式を設定
'*
'*[ARGUMENT]
'*cellINセル
'*strFormulaIN公式
'*
'*====================================================================================================
PrivateSubSetCellFormula()SubSetCellFormula(ByValcellAsExcel.Range,ByValstrFormulaAsString)
Try
cell.Formula=strFormula
CatchexAsException
ThrowNewXlsReportException(ex,XlErrorNo.errFormula,"セルに公式を設定エラー。")
EndTry
EndSub

'*====================================================================================================
'*
'*[PROCEDURE]
'*セルに公式を設定
'*
'*[ARGUMENT]
'*strCellINセル範囲
'*セル範囲は、セル位置(A1参照形式)/変数名/セル名による指定ができます。
'*strFormulaIN公式
'*例えば:XlsReport1.SetFormula("A1","=SUM(A2:A3)")
'*
'*====================================================================================================
PublicSubSetFormula()SubSetFormula(ByValstrCellAsString,ByValstrFormulaAsString)
DimcellAsExcel.Range=GetCell(strCell)
SetCellFormula(cell,strFormula)
EndSub

'*====================================================================================================
'*
'*[PROCEDURE]
'*セルに公式を設定
'*
'*[ARGUMENT]
'*strCellINセル範囲
'*セル範囲は、セル位置(A1参照形式)/変数名/セル名による指定ができます。
'*intOffsetXINstrCellで指定したセル位置から、対象となる範囲を左、または、
'*　　　　　　　　　　　　　　右への移動量を整数型で指定します。
'*intOffsetYINstrCellで指定したセル位置から、対象となる範囲を上、または、
'*下への移動量を整数型で指定します。
'*strFormulaIN公式
'*例えば:XlsReport1.SetFormula("A1",1,1,"=SUM(A2:A3)")
'*
'*====================================================================================================
PublicSubSetFormula()SubSetFormula(ByValstrCellAsString,ByValintOffsetXAsInteger,ByValintOffsetYAsInteger,_
ByValstrFormulaAsString)
DimcellAsExcel.Range=GetCell(strCell)
cell=GetCell(cell.Row+intOffsetX,cell.Column+intOffsetY)
SetCellFormula(cell,strFormula)
EndSub

'*====================================================================================================
'*
'*[PROCEDURE]
'*セルに公式を設定
'*
'*[ARGUMENT]
'*intRowINセルの行(1～)
'*intColINセルの列(1～)
'*strFormulaIN公式
'*例えば:XlsReport1.SetFormula("A1","=SUM(A2:A3)")
'*
'*====================================================================================================
PublicSubSetFormula()SubSetFormula(ByValintRowAsInteger,ByValintColAsInteger,ByValstrFormulaAsString)
DimcellAsExcel.Range=GetCell(intRow,intCol)
SetCellFormula(cell,strFormula)
EndSub

'*====================================================================================================
'*
'*[PROCEDURE]
'*セル値の差し込み
'*
'*[ARGUMENT]
'*cellINセル
'*objValueIN値
'*
'*====================================================================================================
PrivateSubSetCellValue()SubSetCellValue(ByValcellAsExcel.Range,ByValobjValueAsObject)
Try
IfTypeOfobjValueIsArrayThen
DimarrAsArray=CType(objValue,Array)
Ifarr.Rank>1Then
cell.Resize(arr.GetLength(1),arr.GetLength(0)).Value=arr
Else
cell.Resize(1,arr.GetLength(0)).Value=arr
EndIf
Else
cell.Value=objValue
EndIf
CatchexAsException
ThrowNewXlsReportException(ex,XlErrorNo.errValue,"値の差し込みエラー。")
EndTry
EndSub

'*====================================================================================================
'*
'*[PROCEDURE]
'*セル値の差し込み
'*
'*[ARGUMENT]
'*strCellINセル範囲
'*セル範囲は、セル位置(A1参照形式)/変数名/セル名による指定ができます。
'*objValueIN値
'*例えば:XlsReport1.SetValue("A1","アドバンスソフトウェア")
'*XlsReport1.SetValue("**Cell","アドバンスソフトウェア")
'*XlsReport1.SetValue("PostCell","アドバンスソフトウェア")
'*
'*====================================================================================================
PublicSubSetValue()SubSetValue(ByValstrCellAsString,ByValobjValueAsObject)
DimcellAsExcel.Range=GetCell(strCell)
SetCellValue(cell,objValue)
EndSub

'*====================================================================================================
'*
'*[PROCEDURE]
'*セル値の差し込み
'*
'*[ARGUMENT]
'*strCellINセル範囲
'*セル範囲は、セル位置(A1参照形式)/変数名/セル名による指定ができます。
'*intOffsetXINstrCellで指定したセル位置から、対象となる範囲を左、または、
'*　　　　　　　　　　　　　　右への移動量を整数型で指定します。
'*intOffsetYINstrCellで指定したセル位置から、対象となる範囲を上、または、
'*下への移動量を整数型で指定します。
'*objValueIN値
'*例えば:XlsReport1.SetValue("A1",1,1,"アドバンスソフトウェア")
'*XlsReport1.SetValue("**Cell",1,1,"アドバンスソフトウェア")
'*XlsReport1.SetValue("PostCell",1,1,"アドバンスソフトウェア")
'*
'*====================================================================================================
PublicSubSetValue()SubSetValue(ByValstrCellAsString,ByValintOffsetXAsInteger,ByValintOffsetYAsInteger,_
ByValobjValueAsObject)
DimcellAsExcel.Range=GetCell(strCell)
cell=GetCell(cell.Row+intOffsetX,cell.Column+intOffsetY)
SetCellValue(cell,objValue)
EndSub

'*====================================================================================================
'*
'*[PROCEDURE]
'*座標形式による値の差し込み
'*
'*[ARGUMENT]
'*intRowINセルの行(1～)
'*intColINセルの列(1～)
'*strValueIN値
'*例えば:XlsReport1.SetCellValue(1,1,"アドバンスソフトウェア")
'*
'*====================================================================================================
PublicSubSetValue()SubSetValue(ByValintRowAsInteger,ByValintColAsInteger,ByValobjValueAsObject)
DimcellAsExcel.Range=GetCell(intRow,intCol)
SetCellValue(cell,objValue)
EndSub

'*====================================================================================================
'*
'*[FUNCTION]
'*A1参照形式による値を取得
'*
'*[RETURN]
'*セルの値
'*
'*[ARGUMENT]
'*strCellINセル名
'*例えば:XlsReport1.GetCellValue("A1")
'*
'*====================================================================================================
PublicFunctionGetValue()FunctionGetValue(ByValstrCellAsString)AsObject
ReturnGetCell(strCell).Value
EndFunction

'*====================================================================================================
'*
'*[FUNCTION]
'*座標形式による値を取得
'*
'*[RETURN]
'*セルの値
'*
'*[ARGUMENT]
'*intRowINセルの行(1～)
'*intColINセルの列(1～)
'*例えば:XlsReport1.GetCellValue(1,1)
'*
'*====================================================================================================
PublicFunctionGetValue()FunctionGetValue(ByValintRowAsInteger,ByValintColAsInteger)AsObject
ReturnGetCell(intRow,intCol).Value
EndFunction

'*====================================================================================================
'*
'*[PROCEDURE]
'*セルをクリアする。
'*
'*[ARGUMENT]
'*strCellINセル範囲
'*セル範囲は、セル位置(A1参照形式)/変数名/セル名による指定ができます。
'*
'*====================================================================================================
PublicSubCellClear()SubCellClear(ByValstrCellAsString)
DimcellAsExcel.Range=GetCell(strCell)
Try
cell.Clear()
CatchexAsException
ThrowNewXlsReportException(ex,XlErrorNo.errClear,"セルクリアエラー。")
EndTry
EndSub

#EndRegion

行の操作#Region"行の操作"

'*====================================================================================================
'*
'*[FUNCTION]
'*行を取得する
'*
'*[RETURN]
'*行
'*
'*[ARGUMENT]
'*intRowIN開始行番号(1～)の値を設定します。
'*intCountIN行数(1～)の値を設定します。省略時は1になります。
'*
'*====================================================================================================
PrivateFunctionGetRow()FunctionGetRow(ByValintRowAsInteger,OptionalByValintCountAsInteger=1)AsExcel.Range
DimrowAsExcel.Range=Nothing
Try
row=Me.mxstSheet.Rows(String.Format("{0}:{1}",intRow,intRow+intCount-1))
CatchexAsException
EndTry
IfrowIsNothingThen
DimmsgAsString=String.Format("行({0}:{1})ではありません。",intRow,intRow+intCount-1)
ThrowNewXlsReportException(Nothing,XlErrorNo.errRow,msg)
EndIf
Returnrow
EndFunction

'*====================================================================================================
'*
'*[PROCEDURE]
'*行をクリアする。
'*
'*[ARGUMENT]
'*intRowIN開始行番号(1～)の値を設定します。
'*intCountIN行数(1～)の値を設定します。省略時は1になります。
'*
'*====================================================================================================
PublicSubRowClear()SubRowClear(ByValintRowAsInteger,OptionalByValintCountAsInteger=1)
DimrowAsExcel.Range=GetRow(intRow,intCount)
Try
row.Clear()
CatchexAsException
ThrowNewXlsReportException(ex,XlErrorNo.errClear,"行をクリアエラー。")
EndTry
EndSub

'*====================================================================================================
'*
'*[PROCEDURE]
'*行を削除する。
'*
'*[ARGUMENT]
'*intRowIN開始行番号(1～)の値を設定します。
'*intCountIN行数(1～)の値を設定します。省略時は1になります。
'*
'*====================================================================================================
PublicSubRowDelete()SubRowDelete(ByValintRowAsInteger,OptionalByValintCountAsInteger=1)
DimrowAsExcel.Range=GetRow(intRow,intCount)
Try
row.Delete()
CatchexAsException
ThrowNewXlsReportException(ex,XlErrorNo.errDelete,"行を削除エラー。")
EndTry
EndSub

'*====================================================================================================
'*
'*[PROCEDURE]
'*行を隠す。
'*
'*[ARGUMENT]
'*intRowIN開始行番号(1～)の値を設定します。
'*intCountIN行数(1～)の値を設定します。省略時は1になります。
'*
'*====================================================================================================
PublicSubRowHide()SubRowHide(ByValintRowAsInteger,OptionalByValintCountAsInteger=1)
DimrowAsExcel.Range=GetRow(intRow,intCount)
Try
row.Hidden=True
CatchexAsException
ThrowNewXlsReportException(ex,XlErrorNo.errHide,"行を隠すエラー。")
EndTry
EndSub

'*====================================================================================================
'*
'*[PROCEDURE]
'*行をコピーする。intSRow行目をコピーからintDRow行目に貼り付けます、挿入します。
'*
'*[ARGUMENT]
'*intSRowINコピー元の行番号(1～)の値を設定します。
'*intDRowINコピー先の行番号(1～)の値を設定します。
'*enmActionIN貼り付け/挿入。省略時は「貼り付け」になります。
'*
'*====================================================================================================
PublicSubRowCopy()SubRowCopy(ByValintSRowAsInteger,ByValintDRowAsInteger,_
OptionalByValenmActionAsXlCopyAction=XlCopyAction.Paste)
DimsrowAsExcel.Range=GetRow(intSRow)
DimdrowAsExcel.Range=GetRow(intDRow)
Try
srow.Copy()
drow.Select()
IfenmAction=XlCopyAction.PasteThen
Me.mxstSheet.Paste()
ElseIfenmAction=XlCopyAction.InsertThen
drow.Insert(Shift:=Excel.XlInsertShiftDirection.xlShiftDown)
EndIf
CatchexAsException
ThrowNewXlsReportException(ex,XlErrorNo.errCopy,"行をコピーエラー。")
EndTry
EndSub

'*====================================================================================================
'*
'*[PROCEDURE]
'*行をコピーする。intSRow行目からintCount行数をコピー、intDRow行目に貼り付けます、また挿入します。
'*
'*[ARGUMENT]
'*intSRowINコピー元の行番号(1～)の値を設定します。
'*intCountINコピーの行数(1～)の値を設定します。
'*intDRowINコピー先の行番号(1～)の値を設定します。
'*enmActionIN貼り付け/挿入。省略時は「貼り付け」になります。
'*
'*====================================================================================================
PublicSubRowCopy()SubRowCopy(ByValintSRowAsInteger,ByValintCountAsInteger,_
ByValintDRowAsInteger,OptionalByValenmActionAsXlCopyAction=XlCopyAction.Paste)
DimsrowAsExcel.Range=GetRow(intSRow,intCount)
DimdrowAsExcel.Range=GetRow(intDRow)
Try
srow.Copy()
drow.Select()
IfenmAction=XlCopyAction.PasteThen
Me.mxstSheet.Paste()
ElseIfenmAction=XlCopyAction.InsertThen
drow.Insert(Shift:=Excel.XlInsertShiftDirection.xlShiftDown)
EndIf
CatchexAsException
ThrowNewXlsReportException(ex,XlErrorNo.errCopy,"行をコピーエラー。")
EndTry
EndSub

'*====================================================================================================
'*
'*[PROCEDURE]
'*行を挿入する。
'*
'*[ARGUMENT]
'*intRowIN開始行番号(1～)の値を設定します。
'*intCountIN行数(1～)の値を設定します。省略時は1になります。
'*
'*====================================================================================================
PublicSubRowInsert()SubRowInsert(ByValintRowAsInteger,OptionalByValintCountAsInteger=1)
DimrowAsExcel.Range=GetRow(intRow)
Try
ForiAsInteger=0TointCount
row.Insert(Shift:=Excel.XlInsertShiftDirection.xlShiftDown)
Next
CatchexAsException
ThrowNewXlsReportException(ex,XlErrorNo.errInsert,"行を挿入エラー。")
EndTry
EndSub

'*====================================================================================================
'*
'*[PROCEDURE]
'*intSRowからintDRowまで範囲の行高を調整する
'*
'*[ARGUMENT]
'*intSColIN調整元行番号(1～)の値を設定します。
'*intDRowIN調整先行番号(1～)の値を設定します。
'*
'*====================================================================================================
PublicSubRowFit()SubRowFit(ByValintSRowAsInteger,ByValintDRowAsInteger)
Try
DimstrRangeAsString
DimxrgRowsAsExcel.Range
strRange=intSRow.ToString()+":"+intDRow.ToString()
xrgRows=CType(Me.mxstSheet.Rows(strRange),Excel.Range).AutoFit()
CatchexAsException
ThrowNewXlsReportException(ex,XlErrorNo.errFormat)
EndTry
EndSub

'*====================================================================================================
'*
'*[PROCEDURE]
'*行PageBreakを添加する
'*
'*[ARGUMENT]
'*intRowIN行番号(1～)の値を設定します。
'*
'*====================================================================================================
PublicSubRowPageBreakAdd()SubRowPageBreakAdd(ByValintRowAsInteger)
DimrowAsExcel.Range=GetRow(intRow)
Try
mxstSheet.HPageBreaks.Add(Before:=row)
CatchexAsException
ThrowNewXlsReportException(ex,XlErrorNo.errPageBreak)
EndTry
EndSub

#EndRegion

列の操作#Region"列の操作"

'*====================================================================================================
'*
'*[FUNCTION]
'*列を取得する
'*
'*[RETURN]
'*列
'*
'*[ARGUMENT]
'*intColIN開始列番号(1～)の値を設定します。
'*intCountIN列数(1～)の値を設定します。省略時は1になります。
'*
'*====================================================================================================
PrivateFunctionGetCol()FunctionGetCol(ByValintColAsInteger,OptionalByValintCountAsInteger=1)AsExcel.Range
DimcolAsExcel.Range=Nothing
DimsColAddressAsString=""
DimeColAddressAsString=""
Try
sColAddress=CType(Me.mxstSheet.Columns(intCol),Excel.Range).Address.Split(":")(0)
eColAddress=CType(Me.mxstSheet.Columns(intCol+intCount-1),Excel.Range).Address.Split(":")(0)
col=Me.mxstSheet.Columns(String.Format("{0}:{1}",sColAddress,eColAddress))
CatchexAsException
EndTry
IfcolIsNothingThen
DimmsgAsString=String.Format("列({0}:{1})ではありません。",sColAddress,eColAddress)
ThrowNewXlsReportException(Nothing,XlErrorNo.errColumn,msg)
EndIf
Returncol
EndFunction

'*====================================================================================================
'*
'*[PROCEDURE]
'*列をクリアする。
'*
'*[ARGUMENT]
'*intColIN開始列番号(1～)の値を設定します。
'*intCountIN列数(1～)の値を設定します。省略時は1になります。
'*
'*====================================================================================================
PublicSubColumnClear()SubColumnClear(ByValintColAsInteger,OptionalByValintCountAsInteger=1)
DimcolAsExcel.Range=GetCol(intCol,intCount)
Try
col.Clear()
CatchexAsException
ThrowNewXlsReportException(ex,XlErrorNo.errClear,"列をクリアエラー。")
EndTry
EndSub

'*====================================================================================================
'*
'*[PROCEDURE]
'*列を削除する。
'*
'*[ARGUMENT]
'*intColIN開始列番号(1～)の値を設定します。
'*intCountIN列数(1～)の値を設定します。省略時は1になります。
'*
'*====================================================================================================
PublicSubColumnDelete()SubColumnDelete(ByValintColAsInteger,OptionalByValintCountAsInteger=1)
DimcolAsExcel.Range=GetCol(intCol)
Try
col.Delete()
CatchexAsException
ThrowNewXlsReportException(ex,XlErrorNo.errDelete,"列を削除エラー。")
EndTry
EndSub

'*====================================================================================================
'*
'*[PROCEDURE]
'*列を隠す。
'*
'*[ARGUMENT]
'*intColIN開始列番号(1～)の値を設定します。
'*intCountIN列数(1～)の値を設定します。省略時は1になります。
'*
'*====================================================================================================
PublicSubColumnHide()SubColumnHide(ByValintColAsInteger,OptionalByValintCountAsInteger=1)
DimcolAsExcel.Range=GetCol(intCol,intCount)
Try
col.Hidden=True
CatchexAsException
ThrowNewXlsReportException(ex,XlErrorNo.errHide,"列を隠すエラー。")
EndTry
EndSub

'*====================================================================================================
'*
'*[PROCEDURE]
'*列をコピーする。intSCol列目をコピーからintDCol列目に貼り付けます、挿入します。
'*
'*[ARGUMENT]
'*intSColINコピー元の列番号(1～)の値を設定します。
'*intDColINコピー先の列番号(1～)の値を設定します。
'*enmActionIN貼り付け/挿入。省略時は「貼り付け」になります。
'*
'*====================================================================================================
PublicSubColumnCopy()SubColumnCopy(ByValintSColAsInteger,ByValintDColAsInteger,_
OptionalByValenmActionAsXlCopyAction=XlCopyAction.Paste)
DimscolAsExcel.Range=GetCol(intSCol)
DimdcolAsExcel.Range=GetCol(intDCol)
Try
scol.Copy()
dcol.Select()
IfenmAction=XlCopyAction.PasteThen
Me.mxstSheet.Paste()
ElseIfenmAction=XlCopyAction.InsertThen
dcol.Insert(Shift:=Excel.XlInsertShiftDirection.xlShiftToRight)
EndIf
CatchexAsException
ThrowNewXlsReportException(ex,XlErrorNo.errCopy,"列をコピーエラー。")
EndTry
EndSub

'*====================================================================================================
'*
'*[PROCEDURE]
'*列をコピーする。intSCol列目からintCount列数をコピー、intDCol列目に貼り付けます、また挿入します。
'*
'*[ARGUMENT]
'*intSColINコピー元の列番号(1～)の値を設定します。
'*intCountINコピーの列数(1～)の値を設定します。
'*intDColINコピー先の列番号(1～)の値を設定します。
'*enmActionIN貼り付け/挿入。省略時は「貼り付け」になります。
'*
'*====================================================================================================
PublicSubColumnCopy()SubColumnCopy(ByValintSColAsInteger,ByValintCountAsInteger,_
ByValintDColAsInteger,OptionalByValenmActionAsXlCopyAction=XlCopyAction.Paste)
DimscolAsExcel.Range=GetCol(intSCol,intCount)
DimdcolAsExcel.Range=GetCol(intDCol)
Try
scol.Copy()
dcol.Select()
IfenmAction=XlCopyAction.PasteThen
Me.mxstSheet.Paste()
ElseIfenmAction=XlCopyAction.InsertThen
dcol.Insert(Shift:=Excel.XlInsertShiftDirection.xlShiftToRight)
EndIf
CatchexAsException
ThrowNewXlsReportException(ex,XlErrorNo.errCopy,"列をコピーエラー。")
EndTry
EndSub

'*====================================================================================================
'*
'*[PROCEDURE]
'*列を挿入する。
'*
'*[ARGUMENT]
'*intColIN開始列番号(1～)の値を設定します。
'*intCountIN列数(1～)の値を設定します。省略時は1になります。
'*
'*====================================================================================================
PublicSubColumnInsert()SubColumnInsert(ByValintColAsInteger,OptionalByValintCountAsInteger=1)
DimcolAsExcel.Range=GetCol(intCol)
Try
ForiAsInteger=0TointCount
col.Insert(Shift:=Excel.XlInsertShiftDirection.xlShiftToRight)
Next
CatchexAsException
ThrowNewXlsReportException(ex,XlErrorNo.errInsert,"列を挿入エラー。")
EndTry
EndSub

'*====================================================================================================
'*
'*[PROCEDURE]
'*intSColからintDColまで範囲の列を調整する
'*
'*[ARGUMENT]
'*intSColIN調整元列番号(1～)の値を設定します。
'*intDColIN調整先列番号(1～)の値を設定します。
'*
'*====================================================================================================
PublicSubColumnFit()SubColumnFit(ByValintSColAsInteger,ByValintDColAsInteger)
Try
DimstrRangeAsString
DimxrgRowsAsExcel.Range
strRange=intSCol.ToString()+":"+intDCol.ToString()
xrgRows=CType(Me.mxstSheet.Columns(strRange),Excel.Range).AutoFit()
CatchexAsException
ThrowNewXlsReportException(ex,XlErrorNo.errFormat)
EndTry
EndSub

'*====================================================================================================
'*
'*[PROCEDURE]
'*列PageBreakを添加する
'*
'*[ARGUMENT]
'*intColIN行番号(1～)の値を設定します。
'*
'*====================================================================================================
PublicSubColumnPageBreakAdd()SubColumnPageBreakAdd(ByValintColAsInteger)
DimcolAsExcel.Range=GetCol(intCol)
Try
mxstSheet.VPageBreaks.Add(Before:=col)
CatchexAsException
ThrowNewXlsReportException(ex,XlErrorNo.errPageBreak)
EndTry
EndSub

#EndRegion

属性の操作#Region"属性の操作"

PublicSubAttrBorderStyle()SubAttrBorderStyle(ByValstrCellAsString,ByValenmBorderAsXlBorders,_
ByValenmLineStyleAsXlLineStyle)
DimcellAsExcel.Range=GetCell(strCell)
cell.Borders(enmBorder).LineStyle=enmLineStyle
EndSub

PublicSubAttrBorderWeight()SubAttrBorderWeight(ByValstrCellAsString,ByValenmBorderAsXlBorders,_
ByValenmBorderWeightAsXlBorderWight)
DimcellAsExcel.Range=GetCell(strCell)
cell.Borders(enmBorder).Weight=enmBorderWeight
EndSub

PublicSubAttrBorderColor()SubAttrBorderColor(ByValstrCellAsString,ByValenmBorderAsXlBorders,_
ByValintColorAsInteger)
DimcellAsExcel.Range=GetCell(strCell)
Try
cell.Borders(enmBorder).Color=intColor
CatchexAsException
ThrowNewXlsReportException(ex,XlErrorNo.errAttr)
EndTry
EndSub

PublicSubAttrFontFamily()SubAttrFontFamily(ByValstrCellAsString,ByValstrFontFamilyAsString)
DimcellAsExcel.Range=GetCell(strCell)
Try
cell.Font.Name=strFontFamily
CatchexAsException
ThrowNewXlsReportException(ex,XlErrorNo.errAttr)
EndTry
EndSub

PublicSubAttrFontSize()SubAttrFontSize(ByValstrCellAsString,ByValintSizeAsInteger)
DimcellAsExcel.Range=GetCell(strCell)
Try
cell.Font.Size=intSize
CatchexAsException
ThrowNewXlsReportException(ex,XlErrorNo.errAttr)
EndTry
EndSub

PublicSubAttrHorizontalAlign()SubAttrHorizontalAlign(ByValstrCellAsString,ByValenmAlignAsXlHAlign)
DimcellAsExcel.Range=GetCell(strCell)
Try
cell.HorizontalAlignment=enmAlign
CatchexAsException
ThrowNewXlsReportException(ex,XlErrorNo.errAttr)
EndTry
EndSub

PublicSubAttrVerticalAlign()SubAttrVerticalAlign(ByValstrcellAsString,ByValenmAlignAsXlVAlign)
DimcellAsExcel.Range=GetCell(strcell)
Try
cell.VerticalAlignment=enmAlign
CatchexAsException
ThrowNewXlsReportException(ex,XlErrorNo.errAttr)
EndTry
EndSub

PublicSubAttrCellFormat()SubAttrCellFormat(ByValstrCellAsString,ByValenmCellFormatAsXlCellFormat)
DimcellAsExcel.Range=GetCell(strCell)
Try
SelectCaseenmCellFormat
CaseXlCellFormat.xlShrinkToFit
cell.WrapText=True
CaseXlCellFormat.xlShrinkToFit
cell.ShrinkToFit=True
CaseElse
cell.WrapText=False
cell.ShrinkToFit=False
EndSelect
CatchexAsException

EndTry
EndSub

PublicSubAttrFontStyle()SubAttrFontStyle(ByValstrCellAsString,ByValenmFontStyleAsXlFontStyle)
DimcellAsExcel.Range=GetCell(strCell)
Try
SelectCaseenmFontStyle
CaseXlFontStyle.xlOutlineFont
cell.Font.OutlineFont=True
CaseXlFontStyle.xlShadow
cell.Font.Shadow=True
CaseXlFontStyle.xlStrikethrough
cell.Font.Strikethrough=True
CaseXlFontStyle.xlSubscript
cell.Font.Subscript=True
CaseXlFontStyle.xlSuperscript
cell.Font.Superscript=True
CaseXlFontStyle.xlBold
cell.Font.Bold=True
CaseXlFontStyle.xlItalic
cell.Font.Italic=True
CaseXlFontStyle.xlUnderlineDouble
cell.Font.Underline=Excel.XlUnderlineStyle.xlUnderlineStyleDouble
CaseXlFontStyle.xlUnderlineSingle
cell.Font.Underline=Excel.XlUnderlineStyle.xlUnderlineStyleSingle
CaseElse
cell.Font.OutlineFont=False
cell.Font.Shadow=False
cell.Font.Strikethrough=False
cell.Font.Subscript=False
cell.Font.Superscript=False
cell.Font.Bold=False
cell.Font.Italic=False
cell.Font.Underline=Excel.XlUnderlineStyle.xlUnderlineStyleNone
EndSelect
CatchexAsException
ThrowNewXlsReportException(ex,XlErrorNo.errAttr)
EndTry
EndSub

PublicSubAttrFontColor()SubAttrFontColor(ByValstrCellAsString,ByValintColorAsInteger)
DimcellAsExcel.Range=GetCell(strCell)
Try
cell.Font.ColorIndex=intColor
CatchexAsException
ThrowNewXlsReportException(ex,XlErrorNo.errAttr)
EndTry
EndSub

PublicSubAttrBackColor()SubAttrBackColor(ByValstrCellAsString,ByValintColorAsInteger,_
OptionalByValenmFillPatternAsXlFillPattern=XlFillPattern.xlAuto)
DimcellAsExcel.Range=GetCell(strCell)
Try
cell.Interior.ColorIndex=intColor
cell.Interior.Pattern=enmFillPattern
CatchexAsException
ThrowNewXlsReportException(ex,XlErrorNo.errAttr)
EndTry
EndSub

#EndRegion

データの操作#Region"データの操作"

'*====================================================================================================
'*
'*[PROCEDURE]
'*データ貼り付け範囲のクリップボードペースト
'*
'*[ARGUMENT]
'*strCellINセル範囲
'*セル範囲は、セル位置(A1参照形式)/変数名/セル名による指定ができます。
'*strDataINデータ
'*
'*====================================================================================================
PublicSubSetRangeData()SubSetRangeData(ByValstrCellAsString,ByValstrDataAsString)
DimstrHorizonArrayAsString()
DimstrVerticalArrayAsString()
DimintRowCntAsInteger
DimintColCntAsInteger
DimcellAsExcel.Range=GetCell(strCell)
Try
strVerticalArray=strData.Split(ControlChars.Cr)
strHorizonArray=strVerticalArray(0).Split(ControlChars.Tab)
DimstrDataArray(strVerticalArray.Length-1,strHorizonArray.Length-1)AsObject
ForintRowCnt=0TostrVerticalArray.Length-1
ForintColCnt=0TostrHorizonArray.Length-1
strDataArray(intRowCnt,intColCnt)=""
Next
Next
ForintRowCnt=0TostrVerticalArray.Length-1
ForintColCnt=0TostrVerticalArray(intRowCnt).Split(ControlChars.Tab).Length-1
strDataArray(intRowCnt,intColCnt)=strVerticalArray(intRowCnt).Split(ControlChars.Tab)(intColCnt)
Next
Next
IfstrVerticalArray.Length-1>0Then
cell.Resize(strVerticalArray.Length-1,strHorizonArray.Length).Value=strDataArray
EndIf
CatchexAsException
Me.Dispose()
ThrowNewXlsReportException(ex,XlErrorNo.errData)
EndTry
EndSub

'*====================================================================================================
'*
'*[FUNCTION]
'*範囲のデータを取得
'*
'*[RETURN]
'*DataTable
'*
'*[ARGUMENT]
'*intSRowIN開始行番号
'*intSColIN開始列番号
'*blnFirstRowIsHeaderIN範囲の第一行はヘーダの設定
'*
'*====================================================================================================
PublicFunctionGetRangeData()FunctionGetRangeData(ByValintSRowAsInteger,ByValintSColAsInteger,_
OptionalByValblnFirstRowIsHeaderAsBoolean=False)AsDataTable
DimobjDataTableAsDataTable=NewDataTable(Me.mxstSheet.Name)'テーブル
DimintBeginRowAsInteger=1'開始行番号
DimintBeginColAsInteger=1'開始列番号
DimintEndRowAsInteger=1'結束行番号
DimintEndColAsInteger=1'結束列番号
DimobjDataAsObject(,)
Try
'開始行
IfintSRow<1Then
intBeginRow=Me.mxstSheet.UsedRange.Row
Else
intBeginRow=intSRow
EndIf
'開始列
IfintSCol<1Then
intBeginCol=Me.mxstSheet.UsedRange.Column
Else
intBeginCol=intSCol
EndIf
'結束行
IfblnFirstRowIsHeaderThen
intEndRow=intBeginRow+Me.mxstSheet.UsedRange.Rows.Count-1
Else
intEndRow=intBeginRow+Me.mxstSheet.UsedRange.Rows.Count-2
EndIf
'結束列
intEndCol=intBeginCol+Me.mxstSheet.UsedRange.Columns.Count-1

'テープル中の列数の設定
ForiAsInteger=intBeginColTointEndCol
DimobjDataColumnAsSystem.Data.DataColumn
objDataColumn=NewSystem.Data.DataColumn
objDataColumn.DataType=Type.GetType("System.String")
objDataColumn.DefaultValue=""
IfblnFirstRowIsHeaderThen
objDataColumn.ColumnName=Me.mxstSheet.Cells(intBeginRow,intBeginCol+i).Value.ToString()
EndIf
objDataTable.Columns.Add(objDataColumn)
Next

IfblnFirstRowIsHeaderThen
intBeginRow+=1
EndIf

'テープル中のデータの設定
objData=Me.mxstSheet.Range(Me.mxstSheet.Cells(intBeginRow,intBeginCol),_
Me.mxstSheet.Cells(intEndRow,intEndCol)).Value
ForiAsInteger=1ToobjData.GetUpperBound(0)
DimobjDataRowAsSystem.Data.DataRow=objDataTable.NewRow()
ForjAsInteger=1ToobjData.GetUpperBound(1)
objDataRow(j-1)=objData(i,j)
Next
objDataTable.Rows.Add(objDataRow)
Next
CatchexAsException
Me.Dispose()
ThrowNewXlsReportException(ex,XlErrorNo.errData)
EndTry
ReturnobjDataTable
EndFunction

#EndRegion

EndClass

2. XlsReportException.vb

PublicEnumXlErrorNoEnumXlErrorNo
errNoError=0
errOpen
errSave
errClose
errSheet
errAddSheet
errValue
errFormula
errClear
errCopy
errPaste
errInsert
errDelete
errHide
errFormat
errPageBreak
errCell
errRow
errColumn
errData
errAttr
errParam
errFileType
errAppError
errVersion
errOther
EndEnum

PublicClassXlsReportExceptionClassXlsReportException
InheritsException

PrivatemenmErrorNoAsXlErrorNo

PrivatemstrErrorMessageAsString

PublicPropertyErrorNo()PropertyErrorNo()AsXlErrorNo
Get
ReturnmenmErrorNo
EndGet
Set(ByValvalueAsXlErrorNo)
menmErrorNo=value
EndSet
EndProperty

PublicPropertyErrorMsg()PropertyErrorMsg()AsString
Get
ReturnmstrErrorMessage
EndGet
Set(ByValvalueAsString)
mstrErrorMessage=value
EndSet
EndProperty

PublicSubNew()SubNew(ByValexAsException,OptionalByValerrorNoAsXlErrorNo=XlErrorNo.errOther,_
OptionalByValerrorMsgAsString="")
menmErrorNo=errorNo
mstrErrorMessage=errorMsg
IferrorMsg=""AndAlsoexIsNotNothingThen
mstrErrorMessage=ex.Message
EndIf
EndSub
EndClass