フレームExcel印刷


  excelctl.htm



  
<SCRIPT language="VBScript" src="excel.vbs"></SCRIPT>
<SCRIPT language="VBScript">

Dim MyBook

' ************************************************
' 開く
' ************************************************
function XlsOpen()

	Target = document.all("Excel").value

	if Trim(Target) = "" then
		alert("Excel ブックを選択して下さい   ")
		Exit Function
	end if

	Set MyBook = ExcelOpen( Target )
	Call ExcelVisible( true )

	if ExcelApp.WindowState <> xlNormal then
		ExcelApp.WindowState = xlNormal
	end if

	ExcelApp.Left = 1
	ExcelApp.Top = 1

	ExcelApp.Width = ((screen.width / 2) * 72) / screen.deviceXDPI
	ExcelApp.Height = ((screen.height - 32) * 72) / screen.deviceYDPI

	Dim Group

	For Each objElement In document.all
		on error resume next
		Group = objElement.group
		if Err.Number = 0 then
			if objElement.group = 1 then
				objElement.disabled = True
			end if
			if objElement.group = 2 then
				objElement.disabled = False
			end if
		end if
		on error goto 0
	Next

	Call XlsSheetList()
	Call XlsRange()

end function

' ************************************************
' 終了
' ************************************************
function XlsQuit()

	Dim Group

	For Each objElement In document.all
		on error resume next
		Group = objElement.group
		if Err.Number = 0 then
			if objElement.group = 1 then
				objElement.disabled = False
			end if
			if objElement.group = 2 then
				objElement.disabled = True
			end if
		end if
		on error goto 0
	Next

	document.all("SheetList").options.length = 0

	Call ExcelQuit(MyBook)

end function

' ************************************************
' シート一覧
' ************************************************
function XlsSheetList()

	Call ExcelSheetList(MyBook,"SheetList")

end function

' ************************************************
' シート選択
' ************************************************
function XlsSelectSheet()

	Target = document.all("SheetList").value

	Call ExcelSelectSheet(MyBook, Target)

end function

' ************************************************
' 範囲選択
' ************************************************
function XlsRange()

	Target = document.all("SheetList").value
	if Target = "" then
		alert("シートを選択して下さい   ")
		Exit Function
	end if

	Call ExcelSelectSheet(MyBook, Target)

	X1 = Cint(document.all("RangeX1").value)
	Y1 = Cint(document.all("RangeY1").value)
	X2 = Cint(document.all("RangeX2").value)
	Y2 = Cint(document.all("RangeY2").value)

	Call ExcelRange(MyBook, Target, X1, Y1, X2, Y2 )

end function

' ************************************************
' BOX罫線
' ************************************************
function XlsBox()

	Dim LineType,LineWidth

	LineType = Cint(document.all("LineType").value)
	LineWidth = Cint(document.all("LineWidth").value)

	if LineType = xlLineStyleNone then
		Call ClearBox( )
	else
		Call ExcelBox(LineType, LineWidth)
	end if

end function

' ************************************************
' 範囲内罫線
' ************************************************
function XlsInner()

	Dim LineType,LineWidth

	LineType = Cint(document.all("LineType").value)
	LineWidth = Cint(document.all("LineWidth").value)

	if LineType = xlLineStyleNone then
		Call ClearInner( )
	else
		Call ExcelInnerH(LineType, LineWidth)
		Call ExcelInnerV(LineType, LineWidth)
	end if

end function

' ************************************************
' シート複写
' ************************************************
function XlsCopySheet()

	Target = document.all("SheetList").value

	Call ExcelCopySheet(MyBook, Target, _
		Target & Replace(Time(),":", "" ) )

end function

' ************************************************
' 指定行の高さ
' ************************************************
function XlsRowHeight()

	Target = document.all("SheetList").value

	Dim nRow,nHeight

	nRow = Cint(document.all("RowNo").value)
	nHeight = Cint(document.all("RowHeight").value)

	Call ExcelSetRowHeight(MyBook, Target, nRow, nHeight)

end function

' ************************************************
' 指定列の幅
' ************************************************
function XlsColumnWidth()

	Target = document.all("SheetList").value

	Dim nColumn,nWidth

	nColumn = Cint(document.all("ColumnNo").value)
	nWidth = Cint(document.all("ColumnWidth").value)

	Call ExcelSetColumnWidth(MyBook, Target, nColumn, nWidth)

end function

</SCRIPT>

<HTML>
<HEAD>
	<META http-equiv="Content-type" content="text/html; charset=Shift_JIS">
	<TITLE>excel専用</TITLE>
<STYLE>
	.MyCell {
		background-color:silver
	}
	.MyButton {
		width:200
	}
</STYLE>
</HEAD>
<BODY>

<INPUT type=file name=Excel style='width:400'>
<BR>

<INPUT
	class=MyButton
	name=OpenButton
	type=button
	value="開く"
	onClick='Call XlsOpen()'
	group=1
><BR>

<INPUT
	class=MyButton
	name=QuitButton
	type=button
	value="終了"
	onClick='Call XlsQuit()'
	disabled
	group=2
><BR>
<BR>

<INPUT
	class=MyButton
	name=SheetListButton
	type=button
	value="シート一覧"
	onClick='Call XlsSheetList()'
	disabled
	group=2
><BR>
<SELECT
	class=MyButton
	name=SheetList
	disabled
	onChange='Call XlsSelectSheet()'
	group=2
></SELECT><BR>

<INPUT
	class=MyButton
	name=RangeButton
	type=button
	value="範囲選択"
	onClick='Call XlsRange()'
	disabled
	group=2
><BR>
<SELECT
	name=RangeX1
	onChange='Call XlsRange()'
>
</SELECT>
<SELECT
	name=RangeY1
	onChange='Call XlsRange()'
>
</SELECT>
<SELECT
	name=RangeX2
	onChange='Call XlsRange()'
>
</SELECT>
<SELECT
	name=RangeY2
	onChange='Call XlsRange()'
>
</SELECT>
<BR>

<BR>
線種
<SELECT
	name=LineType
>
<OPTION value="1">xlContinuous
<OPTION value="-4115">xlDash
<OPTION value="4">xlDashDot
<OPTION value="5">xlDashDotDot
<OPTION value="-4118">xlDot
<OPTION value="-4119">xlDouble
<OPTION value="13">xlSlantDashDot
<OPTION value="-4142">xlLineStyleNone
</SELECT>
<BR>
線幅
<SELECT
	name=LineWidth
>
<OPTION value="1">xlHairline
<OPTION value="-4138">xlMedium
<OPTION value="4">xlThick
<OPTION value="2">xlThin
</SELECT>
<BR>
<INPUT
	class=MyButton
	name=BoxButton
	type=button
	value="BOX罫線"
	onClick='Call XlsBox()'
	disabled
	group=2
><BR>
<INPUT
	class=MyButton
	name=InnerButton
	type=button
	value="範囲内X罫線"
	onClick='Call XlsInner()'
	disabled
	group=2
><BR>

<BR>
<INPUT
	class=MyButton
	name=CopySheetButton
	type=button
	value="シートの複写"
	onClick='Call XlsCopySheet()'
	disabled
	group=2
><BR>

<BR>
行
<INPUT
	name=RowNo
	size=3
	type=text
	value="3"
	disabled
	group=2
>
高さ
<INPUT
	name=RowHeight
	size=3
	type=text
	value="30"
	disabled
	group=2
><BR>
<INPUT
	class=MyButton
	name=RowHeightButton
	type=button
	value="指定行の高さ"
	onClick='Call XlsRowHeight()'
	disabled
	group=2
><BR>

<BR>
カラム
<INPUT
	name=ColumnNo
	size=2
	type=text
	value="3"
	disabled
	group=2
>
幅
<INPUT
	name=ColumnWidth
	size=3
	type=text
	value="30"
	disabled
	group=2
><BR>
<INPUT
	class=MyButton
	name=ColumnWidthButton
	type=button
	value="指定列の幅"
	onClick='Call XlsColumnWidth()'
	disabled
	group=2
><BR>

</BODY>
</HTML>

<SCRIPT for=window event=onload language="VBScript">

	Dim i,len

	document.all("RangeX1").options.length = 0
	For i = 1 to 20
			len = document.all("RangeX1").options.length
			document.all("RangeX1").options.length = len + 1
			document.all("RangeX1").options(i-1).value = i
			document.all("RangeX1").options(i-1).text = i
			len = document.all("RangeY1").options.length
			document.all("RangeY1").options.length = len + 1
			document.all("RangeY1").options(i-1).value = i
			document.all("RangeY1").options(i-1).text = i
			len = document.all("RangeX2").options.length
			document.all("RangeX2").options.length = len + 1
			document.all("RangeX2").options(i-1).value = i
			document.all("RangeX2").options(i-1).text = i
			len = document.all("RangeY2").options.length
			document.all("RangeY2").options.length = len + 1
			document.all("RangeY2").options(i-1).value = i
			document.all("RangeY2").options(i-1).text = i
	Next
	document.all("RangeX2").value = 3
	document.all("RangeY2").value = 10

	window.focus()
	top.resizeTo screen.width / 2, screen.height - 32
	top.moveTo screen.width / 2, 0

	

</SCRIPT>
<SCRIPT for=window event=onunload language="VBScript">

	Call ExcelQuit(MyBook)

</SCRIPT>
  










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





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

SQLの窓フリーソフト

素材

一般WEBツールリンク

SQLの窓

フリーソフト

JSライブラリ