SQLの窓

2015年03月25日


ブラウザ上にあるデータを PHP で受け取って、VBScript のコードを作成して事前に作成済のテンプレート Excel にデータをロードして印刷で使用する

ブラウザ上のデータ

ブラウザ上は UTF-8 である事を想定しています。Shift_JIS のページからでは VBScript では変換しづらい文字が送られる可能性があります。UTF-8 のページかあるいは、『accept-charset="UTF-8"』を属性にもつ FORM 要素を使って、PHP に UTF-8 でデータを出力します。

VBScript を UTF-8 で作成

Windows の VBScript で ファイルを UTF-8 にする場合は、BOM が先頭に付加されたファイルである必要があります。( これが無いものは UTF-8N と呼ばれています )。なので、PHP で chr(0xef) と chr(0xbb) と chr(0xbf) を先頭で出力しています

Excel の処理

Excel 関連の関数はあらかじめ埋め込んであります。VBScript に対してのデータのインターフェイスは RESOURCE 要素内に $_POST データを \r\n( 行 ) を区切り文字にして並べています。このデータを配列に変換して、Excel の特定のシートに縦に並べます。

テンプレート Excel は、そのデータを参照して別のシートに印刷フォーマットを作成してあります。Excel のテンプレートとこの .wsf ファイルを同じフォルダにダウンロードしてスクリプトを実行すると、デスクトップに Excel が開いて後は印字するだけとなります
<?php
$file = 'excel.wsf';

header('Content-Type: application/octet-stream');
header('Content-Disposition: attachment; filename='.basename($file));
header('Expires: 0');
header('Cache-Control: must-revalidate');
header('Pragma: public');

print chr(0xef);
print chr(0xbb);
print chr(0xbf);
?>
<JOB>
<COMMENT>
********************************************
※ COMMENT 要素内はコメントです
********************************************
</COMMENT>

<OBJECT id="ExcelApp" progid="Excel.Application" />
<OBJECT id="Wsh" progid="WScript.Shell" />
<OBJECT id="FileSystem" progid="Scripting.FileSystemObject" />

<SCRIPT language="VBScript">
'*******************************************
' 処理開始
'*******************************************

' ソース内テキストデータの取得
aData = Split( RegTrim(GetResource("myTextData")), vbCrLf )

' 変数定義( 必須ではありません )
Dim MyBook,TargetSheet,TargetExcel,ExcelFile,TargetName,PrintSheet

' テンプレート Excel ブックのパス
' 基本的には、カレントを使用するほうが良いでしょう
ExcelFile = Replace( aData(0), "\\", "\" )
' データ作成用の対象者の日本語名( 余計なスペースを省いています )
TargetName = Replace( aData(1), " ", "" )
TargetName = Replace( TargetName, " ", "" )
' データをセットするシート名
TargetSheet = aData(2)
' 印字するシート名
PrintSheet = aData(3)

' テンプレート Excel から作成する新しいブックファイル名
TargetExcel = Replace(LCase(ExcelFile), ".xlsx", "" ) & "_" & TargetName & ".xlsx"

' コピーして作成
FileSystem.CopyFile ExcelFile, TargetExcel, True

' Excel 読み込み
Set MyBook = ExcelOpen( TargetExcel )

' シート選択
Call ExcelSelectSheet(MyBook, TargetSheet)

' 印字情報の一覧 ( aData(4) 〜 )
For I = 4 to Ubound(aData)
	Call ExcelSetCell(MyBook, TargetSheet, 2, I-3, aData(I) )
Next

Call ExcelSelectSheet(MyBook, PrintSheet)
Call ExcelSave(MyBook)
Call ExcelQuit(MyBook)

LoadExcel( TargetExcel )

'*******************************************
' 文字列前後の漢字スペースを含むホワイトスペースの削除
'*******************************************
Function RegTrim( strValue )

	Dim regEx, str

	Set regEx = New RegExp
	regEx.IgnoreCase = True
	regEx.Pattern = "^[ \s]+"
	str = regEx.Replace( strValue, "" )
	regEx.Pattern = "[ \s]+$"
	RegTrim = regEx.Replace( str, "" )

End Function

' ******************************************************
' ブックを デスクトップに開く
' ******************************************************
Function LoadExcel(strPath)

	Call Wsh.Run( "RunDLL32.EXE url.dll,FileProtocolHandler " & _
		strPath )

End Function

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

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

End Function

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

	ExcelApp.Visible = bFlg

End Function

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

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

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 ExcelSetCellFontSize(MyBook, strSheetName, x, y, Data)

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

End Function

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

	ExcelGetSheetCount = MyBook.Sheets.Count

End Function

' ******************************************************
' 列の自動調整
' ******************************************************
Function ExcelAutofit(MyBook,strSheetName)

	MyBook.Worksheets(strSheetName).UsedRange.EntireColumn.Autofit()

End Function
</SCRIPT>

<COMMENT>
********************************************
 ソース内テキストデータ
********************************************
</COMMENT>
<RESOURCE id="myTextData">
<![CDATA[
<?php
	foreach( $_POST as $key => $val ) {
		print $_POST[$key] . "\r\n";
	}
?>
]]>
</RESOURCE>

</JOB>

この処理はもともと、IE 上に表示されたデータを IE上のスクリプトとして VBScript を使用し、Excel.Application で Excel を使って印刷処理を実装していたものです。今でも利用していますが、今後の将来を考えると、Google Chrome でも使用可能にする為にスクリプトをダウンロードさせる形式を作ってみました。

ダウンロードした Excel ブックのパス(テンプレート)はセキュリティ上の問題で取得できませんが、社内であればネットワーク上に置いておけば固定のパスとして利用可能だと思います。




タグ:EXCEL VBScript PHP
posted by lightbox at 2015-03-25 15:09 | VBS + オブジェクト | このブログの読者になる | 更新情報をチェックする
container 終わり

フリーフォントで簡単ロゴ作成
フリーフォントでボタン素材作成
フリーフォントで吹き出し画像作成
フリーフォントではんこ画像作成
ほぼ自由に利用できるフリーフォント
フリーフォントの書体見本とサンプル
画像を大きく見る為のウインドウを開くボタンの作成

CSS ドロップシャドウの参考デモ
BUTTONS (CSS でボタン)
イラストAC
ぱくたそ
写真素材 足成
フリーフォント一覧
utf8 文字ツール
右サイド 終わり
base 終わり