|
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
' ******************************************************
' Excel 実行 ( NT5.0 以上 )
' ******************************************************
Function ExcelLoad(strPath)
Dim WSH
Set WSH = CreateObject("WScript.Shell")
Call WSH.Run( "RunDLL32.EXE shell32.dll,ShellExec_RunDLL " & _
strPath )
' "RunDLL32.EXE url.dll,FileProtocolHandler "
End Function
' ******************************************************
' オブジェクト作成
' ******************************************************
Function ExcelInit()
If Not IsObject(ExcelApp) Then
Set ExcelApp = CreateObject("Excel.Application")
End If
End Function
' ******************************************************
' ブックを開く(Workbookを返す)
' ******************************************************
Function ExcelOpen(strPath)
ExcelInit
Set ExcelOpen = ExcelApp.Workbooks.Open(strPath)
' アクティブなウィンドウを最大化
ExcelApp.ActiveWindow.WindowState = 2
End Function
' ******************************************************
' 表示状態の変更
' ******************************************************
Function ExcelVisible(bFlg)
ExcelInit
ExcelApp.Visible = bFlg
End Function
' ******************************************************
' 終了
' ******************************************************
Function ExcelQuit(WorkBook)
If TypeName(WorkBook) = "Workbook" Then
' 保存した事にする
WorkBook.Saved = True
End If
If IsObject(ExcelApp) Then
ExcelApp.Quit
Set ExcelApp = Nothing
End If
ExcelApp = ""
End Function
' ******************************************************
' シート名によるシート選択
' ******************************************************
Function ExcelSelectSheet(MyBook, strSheetName)
MyBook.Sheets(strSheetName).Select
End Function
' ******************************************************
' 番号よるシート選択
' ******************************************************
Function ExcelSelectSheetByNo(MyBook, No)
MyBook.Sheets(No).Select
End Function
' ******************************************************
' シート名によるシート複写
' ******************************************************
Function ExcelCopySheet(MyBook, strSheetName, strNewSheetName)
MyBook.Sheets(strSheetName).Copy (MyBook.Sheets(strSheetName))
MyBook.ActiveSheet.Name = strNewSheetName
End Function
' ******************************************************
' シート名によるシート名変更
' ******************************************************
Function ExcelRenameSheet(MyBook, strSheetName, strNewSheetName)
MyBook.Sheets(strSheetName).Name = strNewSheetName
End Function
' ******************************************************
' 上書き保存
' ******************************************************
Function ExcelSave(MyBook)
MyBook.Save
End Function
' ******************************************************
' 名前を付けて保存
' ******************************************************
Function ExcelSaveAs(MyBook, strFileName)
MyBook.SaveAs strFileName
End Function
' ******************************************************
' セルへのデータセット
' ******************************************************
Function ExcelSetCell(MyBook, strSheetName, x, y, Data)
MyBook.Sheets(strSheetName).Cells(y, x) = Data
End Function
' ******************************************************
' シートの数
' ******************************************************
Function ExcelGetSheetCount(MyBook)
ExcelGetSheetCount = MyBook.Sheets.Count
End Function
' ******************************************************
' 範囲選択
' ******************************************************
Function ExcelRange(MyBook, strSheetName, nX1, nY1, nX2, nY2 )
Dim Sheet,strRange
Set Sheet = MyBook.Sheets(strSheetName)
Sheet.Select
strRange = Chr(Asc("A") + nX1 - 1) & nY1 & ":"
strRange = strRange & Chr(Asc("A") + nX2 - 1) & nY2
Sheet.Range(strRange).Select
End Function
' ******************************************************
' 範囲の上に罫線
' ******************************************************
Function ExcelLine( nLineType, nWeight )
With ExcelApp.Selection.Borders(xlEdgeTop)
.LineStyle = nLineType
.ColorIndex = xlAutomatic
.Weight = nWeight
End With
End Function
' ******************************************************
' 範囲に罫線
' ******************************************************
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
' ******************************************************
' 範囲内の罫線を全てクリア
' ******************************************************
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
' ******************************************************
' 範囲内の内部罫線のみクリア
' ******************************************************
Function ClearInner( )
With ExcelApp.Selection.Borders(xlInsideHorizontal)
.LineStyle = xlLineStyleNone
End With
With ExcelApp.Selection.Borders(xlInsideVertical)
.LineStyle = xlLineStyleNone
End With
End Function
' ******************************************************
' 範囲内に罫線
' ******************************************************
Function ExcelInnerH( nLineType, nWeight )
With ExcelApp.Selection.Borders(xlInsideHorizontal)
.LineStyle = nLineType
.ColorIndex = xlAutomatic
.Weight = nWeight
End With
End Function
' ******************************************************
' 範囲内に罫線
' ******************************************************
Function ExcelInnerV( nLineType, nWeight )
With ExcelApp.Selection.Borders(xlInsideVertical)
.LineStyle = nLineType
.ColorIndex = xlAutomatic
.Weight = nWeight
End With
End Function
' ******************************************************
' Excelウィンドウ内で可能な限り大きく表示
' ******************************************************
Function ExcelFitInExcel( )
With ExcelApp.ActiveWindow
.WindowState = xlNormal
.Top = 1
.Left = 1
.Height = ExcelApp.UsableHeight
.Width = ExcelApp.UsableWidth
End With
End Function
' ******************************************************
' Excelウィンドウ内で最大化
' ******************************************************
Function ExcelMaximizedInExcel( )
With ExcelApp.ActiveWindow
.WindowState = xlMaximized
End With
End Function
' ******************************************************
' 指定行の高さを取得
' ******************************************************
Function ExcelGetRowHeight(MyBook, strSheetName, row)
ExcelGetRowHeight = _
MyBook.Sheets(strSheetName).Rows(row).RowHeight
End Function
' ******************************************************
' 指定行の高さを設定
' ******************************************************
Function ExcelSetRowHeight(MyBook, strSheetName, row, Height)
MyBook.Sheets(strSheetName).Rows(row).RowHeight = _
Height
End Function
' ******************************************************
' 指定列の幅を取得
' ******************************************************
Function ExcelGetColumnWidth(MyBook, strSheetName, column)
Dim strColumn
strColumn = Chr(Asc("A") + column - 1)
ExcelGetColumnWidth = _
MyBook.Sheets(strSheetName).Columns(strColumn).ColumnWidth
End Function
' ******************************************************
' 指定列の幅を設定
' ******************************************************
Function ExcelSetColumnWidth(MyBook, strSheetName, column, Width)
Dim strColumn
strColumn = Chr(Asc("A") + column - 1)
MyBook.Sheets(strSheetName).Columns(strColumn).ColumnWidth = _
Width
End Function
' ******************************************************
' シート一覧をコンボ(リスト)ボックスに設定
' ******************************************************
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
| |