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

Google

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

VBScriptドキュメント

タグ：EXCEL VBScript PHP

【VBS + オブジェクトの最新記事】

【VBScript関連のカテゴリ】

posted by lightbox at 2015-03-25 15:09 | VBS + オブジェクト |

Seesaa ブログ

	SQLServer の BCP で INT IDENTITY 列に csv からリストアする
	MySQL に PIPES_AS_CONCAT を設定して、CSV を出力する SQL
	Chrome ポリシー : レジストリ : ( ChatGPT 解説 )
	PL/SQL : 最も簡単な CSV 出力の記述
	VBScript を『管理者として実行する』には、Shell の runas ( 右クリックメニューの実行と同等 ) で実現します / Jscript も追加
	fake sendmail for windows を使って、PHP でごく普通に( mb_send_mail で )メール送信
	TCPDF をダウンロードして、Windows の任意のフォルダで TCPDF 同梱のサンプルを実行する為の設定
	JavaScript : window オブジェクトのプロパティとしてグローバル変数を定義する
	TCPDF をダウンロードして、フリーフォントを埋め込み型で使用する方法
	汎用型 : JSON データより履歴書のフォームを出力するサンプル
	ChatGPT でトップまでスクロールするブックマークレット
	Replit : cs-list
	Replit : js-web-speech
	Replit : js-csv-read-utf8
	Replit : text-editor
	指定した位置でレジストリエディタを開く為の VBScript をダウンロードします
	JScript / VBScript : 指定したフォルダ内のフォルダ毎の使用済みサイズを読める範囲でレポートする
	デスクトップを部分キャプチャした時に切り取り&スケッチを起動してキャプチャ画像に枠線を付加させる。
	#Zoom の必殺技 : 相手に自分の Zoom 関連のウインドウを見せる
	GAS でユーザ作成 : 組織は "orgUnitPath": "/組織名A/組織名B"

	一部のファイル形式がブロックされる(GMail)
	Creating Shortcut Menu Handlers
	Microsoft Word のキーボードショートカット
	Excel のショートカットキーとファンクションキー
	サイトへの不自然なリンクを否認する新しいツールの提供を開始しました

logical error

2015年03月25日

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

logical　error