フレームExcel印刷


  excel.vbs



  
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
  










  infoboard   管理者用   
このエントリーをはてなブックマークに追加





フリーフォントWEBサービス
SQLの窓WEBサービス

SQLの窓フリーソフト

素材

一般WEBツールリンク

SQLの窓

フリーソフト

JSライブラリ