フレームExcel印刷

excel.htm

<SCRIPT language=VBScript>

' **********************************************************
' エクセルブックのダウンロード説明
' **********************************************************
function Axls()

	window.event.returnValue = false
	alert("右クリックで、「対象をファイルに保存」でダウンロードして下さい     ")

end function

</SCRIPT>
<HTML>
<HEAD>
	<META http-equiv="Content-type" content="text/html; charset=Shift_JIS">
	<TITLE>excel専用</TITLE>
<STYLE>
	.MyCell {
		background-color:silver
	}
</STYLE>
</HEAD>
<BODY>
<TABLE>
	<TR>
	<TD valign=top>1)</TD>
	<TD>
		<A
			href='./商品分類マスタ.xls'
			onClick='Axls()'
		>出力の元フォーマットとなるエクセルのダウンロード</a>
	</TD>
	</TR>
</TABLE>

<BR>

<TABLE>
	<TR>
	<TD valign=top>2)</TD>
	<TD>
		ダウンロードしたエクセルブックまたは、カスタムのエクセルブックを選択して下さい<br>
	</TD>
	</TR>
</TABLE>
<INPUT type=file name=Excel style='width:500'>
</BODY>
</HTML>

excel.vbs

Dim ExcelApp
' ******************************************************
' Excel 実行 ( NT5.0 以上 )
' ******************************************************
Function LoadExcel(strPath)

	Set WSH = CreateObject("WScript.Shell")

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

	Set WSH = Nothing

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 Test(MyBook)

	MyBook.Sheets(TargetSheet).Activate
	MyBook.ActiveSheet.Range("A1:A1").Select

end function

fs.vbs

Dim FileSystem

' ******************************************************
' 初期化
' ******************************************************
Function FsInit()

	If Not IsObject(FileSystem) Then
		Set FileSystem = CreateObject("Scripting.FileSystemObject")
	End If

End Function

' ******************************************************
' ファイルの複写
' ******************************************************
Function FsCopy(strFrom, strTo)

	Call FsInit

	FileSystem.CopyFile strFrom, strTo, True

End Function