Dim ExcelApp

Const xlContinuous = 1
Const xlDash = -4115
Const xlDashDot = 4
Const xlDashDotDot = 5
Const xlDot = -4118
Const xlDouble = -4119
Const xlSlantDashDot = 13
Const xlLineStyleNone = -4142

Const xlHairline = 1
Const xlMedium = -4138
Const xlThick = 4
Const xlThin = 2

Const xlInsideHorizontal = 12
Const xlInsideVertical = 11
Const xlDiagonalDown = 5
Const xlDiagonalUp = 6
Const xlEdgeBottom = 9
Const xlEdgeLeft = 7
Const xlEdgeRight = 10
Const xlEdgeTop = 8

Const xlAutomatic = -4105

Const xlMaximized = -4137
Const xlMinimized = -4140
Const xlNormal = -4143

Const xlGeneral = 1
Const xlLeft = -4131
Const xlCenter = -4108
Const xlRight = -4152
Const xlFill = 5
Const xlJustify = -4130
Const xlCenterAcrossSelection = 7
Const xlDistributed = -4117
Const xlTop = -4160
Const xlBottom = -4107

REM ******************************************************
REM Excel 実行 ( NT5.0 以上 )
REM ******************************************************
Function ExcelLoad(strPath)

	Dim WSH

	Set WSH = CreateObject("WScript.Shell")

	Call WSH.Run( "RunDLL32.EXE shell32.dll,ShellExec_RunDLL " & _
		strPath )

End Function

REM ******************************************************
REM オブジェクト作成
REM ******************************************************
Function ExcelInit()

	If Not IsObject(ExcelApp) Then
		Set ExcelApp = CreateObject("Excel.Application")
	End If

End Function

REM ******************************************************
REM ブックを開く(Workbookを返す)
REM ******************************************************
Function ExcelOpen(strPath)

	ExcelInit

	Set ExcelOpen = ExcelApp.Workbooks.Open(strPath)
	
	REM アクティブなウィンドウを最大化
	ExcelApp.ActiveWindow.WindowState = 2

End Function

REM ******************************************************
REM 表示状態の変更
REM ******************************************************
Function ExcelVisible(bFlg)

	ExcelInit
	
	ExcelApp.Visible = bFlg

End Function

REM ******************************************************
REM 終了
REM ******************************************************
Function ExcelQuit(WorkBook)

	If TypeName(WorkBook) = "Workbook" Then
		REM 保存した事にする
		WorkBook.Saved = True
	End If
	If IsObject(ExcelApp) Then
		ExcelApp.Quit
		Set ExcelApp = Nothing
	End If
	ExcelApp = ""

End Function

REM ******************************************************
REM シート名によるシート選択
REM ******************************************************
Function ExcelSelectSheet(MyBook, strSheetName)

	MyBook.Sheets(strSheetName).Select

End Function

REM ******************************************************
REM 番号よるシート選択
REM ******************************************************
Function ExcelSelectSheetByNo(MyBook, No)

	MyBook.Sheets(No).Select

End Function

REM ******************************************************
REM シート名によるシート複写
REM ******************************************************
Function ExcelCopySheet(MyBook, strSheetName, strNewSheetName)

	MyBook.Sheets(strSheetName).Copy (MyBook.Sheets(strSheetName))
	MyBook.ActiveSheet.Name = strNewSheetName

End Function

REM ******************************************************
REM シート名によるシート名変更
REM ******************************************************
Function ExcelRenameSheet(MyBook, strSheetName, strNewSheetName)

	MyBook.Sheets(strSheetName).Name = strNewSheetName

End Function

REM ******************************************************
REM 上書き保存
REM ******************************************************
Function ExcelSave(MyBook)

	MyBook.Save

End Function

REM ******************************************************
REM 名前を付けて保存
REM ******************************************************
Function ExcelSaveAs(MyBook, strFileName)

	MyBook.SaveAs strFileName

End Function

REM ******************************************************
REM セルへのデータセット
REM ******************************************************
Function ExcelSetCell(MyBook, strSheetName, x, y, Data)

	MyBook.Sheets(strSheetName).Cells(y, x) = Data

End Function

REM ******************************************************
REM シートの数
REM ******************************************************
Function ExcelGetSheetCount(MyBook)

	ExcelGetSheetCount = MyBook.Sheets.Count

End Function

REM ******************************************************
REM 範囲選択
REM ******************************************************
Function ExcelRange(MyBook, strSheetName, nX1, nY1, nX2, nY2 )

	Dim Sheet,strRange

	Set Sheet = MyBook.Sheets(strSheetName)
	Sheet.Select
	if nX1 >= 27 then
		strRange = Chr(Asc("A")+Cint(nX1/27)-1) & Chr(Asc("A") + ((nX1+1) mod 27) - 1) & nY1 & ":"
	else
		strRange = Chr(Asc("A") + nX1 - 1) & nY1 & ":"
	end if
	if nX2 >= 27 then
		strRange = strRange & Chr(Asc("A")+Cint(nX2/27)-1) & Chr(Asc("A") + ((nX2+1) mod 27) - 1) & nY2
	else 
		strRange = strRange & Chr(Asc("A") + nX2 - 1) & nY2
	end if
	Sheet.Range(strRange).Select

End Function

REM ******************************************************
REM 範囲の上に罫線
REM ******************************************************
Function ExcelLine( nLineType, nWeight )

	With ExcelApp.Selection.Borders(xlEdgeTop)
		.LineStyle = nLineType
		.ColorIndex = xlAutomatic
		.Weight = nWeight
	End With

End Function

REM ******************************************************
REM 範囲の右に罫線（＊追加＊）
REM ******************************************************
Function ExcelLineRight( nLineType, nWeight )

	With ExcelApp.Selection.Borders(xlEdgeRight)
		.LineStyle = nLineType
		.ColorIndex = xlAutomatic
		.Weight = nWeight
	End With

End Function

REM ******************************************************
REM 範囲に罫線
REM ******************************************************
Function ExcelBox( nLineType, nWeight )

	With ExcelApp.Selection.Borders(xlEdgeTop)
		.LineStyle = nLineType
		.ColorIndex = xlAutomatic
		.Weight = nWeight
	End With
	With ExcelApp.Selection.Borders(xlEdgeLeft)
		.LineStyle = nLineType
		.ColorIndex = xlAutomatic
		.Weight = nWeight
	End With
	With ExcelApp.Selection.Borders(xlEdgeRight)
		.LineStyle = nLineType
		.ColorIndex = xlAutomatic
		.Weight = nWeight
	End With
	With ExcelApp.Selection.Borders(xlEdgeBottom)
		.LineStyle = nLineType
		.ColorIndex = xlAutomatic
		.Weight = nWeight
	End With

End Function

REM ******************************************************
REM 範囲内の罫線を全てクリア
REM ******************************************************
Function ClearBox( )

	With ExcelApp.Selection.Borders(xlEdgeTop)
		.LineStyle = xlLineStyleNone
	End With
	With ExcelApp.Selection.Borders(xlEdgeLeft)
		.LineStyle = xlLineStyleNone
	End With
	With ExcelApp.Selection.Borders(xlEdgeRight)
		.LineStyle = xlLineStyleNone
	End With
	With ExcelApp.Selection.Borders(xlEdgeBottom)
		.LineStyle = xlLineStyleNone
	End With
	With ExcelApp.Selection.Borders(xlInsideHorizontal)
		.LineStyle = xlLineStyleNone
	End With
	With ExcelApp.Selection.Borders(xlInsideVertical)
		.LineStyle = xlLineStyleNone
	End With

End Function

REM ******************************************************
REM 範囲内の内部罫線のみクリア
REM ******************************************************
Function ClearInner( )

	With ExcelApp.Selection.Borders(xlInsideHorizontal)
		.LineStyle = xlLineStyleNone
	End With
	With ExcelApp.Selection.Borders(xlInsideVertical)
		.LineStyle = xlLineStyleNone
	End With

End Function

REM ******************************************************
REM 範囲内に罫線
REM ******************************************************
Function ExcelInnerH( nLineType, nWeight )

	With ExcelApp.Selection.Borders(xlInsideHorizontal)
		.LineStyle = nLineType
		.ColorIndex = xlAutomatic
		.Weight = nWeight
	End With

End Function

REM ******************************************************
REM 範囲内に罫線
REM ******************************************************
Function ExcelInnerV( nLineType, nWeight )

	With ExcelApp.Selection.Borders(xlInsideVertical)
		.LineStyle = nLineType
		.ColorIndex = xlAutomatic
		.Weight = nWeight
	End With

End Function

REM ******************************************************
REM Excelウィンドウ内で可能な限り大きく表示
REM ******************************************************
Function ExcelFitInExcel( )

	With ExcelApp.ActiveWindow
		.WindowState = xlNormal
		.Top = 1
		.Left = 1
		.Height = ExcelApp.UsableHeight
		.Width = ExcelApp.UsableWidth
	End With

End Function

REM ******************************************************
REM Excelウィンドウ内で最大化
REM ******************************************************
Function ExcelMaximizedInExcel( )

	With ExcelApp.ActiveWindow
		.WindowState = xlMaximized
	End With

End Function

REM ******************************************************
REM 指定行の高さを取得
REM ******************************************************
Function ExcelGetRowHeight(MyBook, strSheetName, row)

	ExcelGetRowHeight = _
	MyBook.Sheets(strSheetName).Rows(row).RowHeight

End Function

REM ******************************************************
REM 指定行の高さを設定
REM ******************************************************
Function ExcelSetRowHeight(MyBook, strSheetName, row, Height)

	MyBook.Sheets(strSheetName).Rows(row).RowHeight = _
	Height

End Function

REM ******************************************************
REM 指定列の幅を取得
REM ******************************************************
Function ExcelGetColumnWidth(MyBook, strSheetName, column)

	Dim strColumn

	strColumn = Chr(Asc("A") + column - 1)

	ExcelGetColumnWidth = _
	MyBook.Sheets(strSheetName).Columns(strColumn).ColumnWidth

End Function

REM ******************************************************
REM 指定列の幅を設定
REM ******************************************************
Function ExcelSetColumnWidth(MyBook, strSheetName, column, Width)

	Dim strColumn

	strColumn = Chr(Asc("A") + column - 1)

	MyBook.Sheets(strSheetName).Columns(strColumn).ColumnWidth = _
	Width

End Function

REM ******************************************************
REM シート一覧をコンボ(リスト)ボックスに設定
REM ******************************************************
Function ExcelSheetList(MyBook, strName)

	document.all(strName).options.length = 0
	For i = 1 to ExcelGetSheetCount(MyBook)

		document.all(strName).options.length = i
		document.all(strName).options(i-1).value = MyBook.sheets(i).name
		document.all(strName).options(i-1).text = MyBook.sheets(i).name

	Next

End Function

REM ******************************************************
REM 文字列の横位置を指定（＊追加＊）
REM ******************************************************
Function ExcelHAlign()

	ExcelApp.Selection.HorizontalAlignment = xlCenterAcrossSelection

End Function
Function ExcelHAlign2()

	ExcelApp.Selection.HorizontalAlignment = xlCenter

End Function

REM ******************************************************
REM 文字列の縦位置を指定（＊追加＊）
REM ******************************************************
Function ExcelVAlign()

	ExcelApp.Selection.VerticalAlignment = xlCenter

End Function

REM ******************************************************
REM 文字列の書式を設定（＊追加＊）
REM ******************************************************
Function ExcelSetFont(xlFontStyle, xlFontSize)

	With ExcelApp.Selection.Font
		.FontStyle = xlFontStyle
		.Size = xlFontSize
	End With

End Function

REM ************************************************
REM Excel ブック作成（＊追加＊）
REM ************************************************
function CreateBook(BookPath)

	ExcelInit

	ExcelApp.DisplayAlerts = False

	ExcelApp.Workbooks.Add
	nBooks = ExcelApp.Workbooks.Count
	Set CreateBook = ExcelApp.Workbooks( nBooks )
	CreateBook.Activate

	Dim book
	book = Split(BookPath,".")
	Dim ext
	ext = Ucase(book(Ubound(book)))

	on error resume next
	if ext = "XLS" then
		if CLng(Left(ExcelApp.Version & "",2 )) > 11 then
			Call CreateBook.SaveAs( BookPath, 56 )
		else
			Call CreateBook.SaveAs( BookPath )
		end if
	else
		Call CreateBook.SaveAs( BookPath )
	end if

	if Err.Number <> 0 then
		CreateBook = "ERROR:" & Err.Description
	end if
	on error goto 0

End Function


REM ******************************************************
REM 先頭にシートを追加
REM ******************************************************
function AddSheetTop( MyBook, SheetName )

	Dim Worksheet
	Dim Worksheet2

	Set Worksheet = MyBook.Worksheets( 1 )
	Worksheet.Activate
	MyBook.Worksheets.Add
	Set Worksheet2 = MyBook.ActiveSheet
	on error resume next
	Worksheet2.Name = SheetName
	on error goto 0

	AddSheetTop = Worksheet2.Name

end function

REM ******************************************************
REM 最後にシートを追加
REM ******************************************************
function AddSheetLast( MyBook, SheetName )

	Dim Worksheet
	Dim Worksheet2
	Dim nSheets

	nSheets = MyBook.Worksheets.Count
	Set Worksheet = MyBook.Worksheets( nSheets )
	Worksheet.Activate
	Call MyBook.Worksheets.Add(,Worksheet)
	Set Worksheet2 = MyBook.ActiveSheet
	on error resume next
	Worksheet2.Name = SheetName
	on error goto 0

	AddSheetLast = Worksheet2.Name

end function

REM ******************************************************
REM シート名でシートを削除
REM ******************************************************
function DeleteSheet( MyBook, SheetName )

	Dim Worksheet

	Set Worksheet = MyBook.Worksheets( SheetName )

	on error resume next
	Worksheet.Delete
	on error goto 0

end function