SQLの窓

2018年05月27日


VBScript : 新しい Excel の Book を作成する

Excel 2007 以降の場合

VBScript : Excel の新しいBookを作成する
2007 以降の場合、.xls の拡張子で保存時はフォーマットを指定しないと読みだす時に警告が出るようです

サンプルは、.xlsx で保存しています

イントラネットのWEBページで利用されるテクニックの基本的な部分です。イントラネットの場合は、フォーマットを事前に作成しておくので、Excel ブックの作成を行う事は稀ですが、簡単な運用に使う場合は新規にブックが必要になると思います

※ 複数回実行すると上書きされます

昔から、Excel.Application の扱いはけっこう厄介で、実行する毎に Quit しておくとトラブルを最低限に抑える事ができます。しかし、操作方法のルールとリカバリ方法をマニュアル化しておく事が最も重要になります( トラブル時は、非表示のままメモリに残るので、タスクマネージャからタスクの終了をする必要があります )
' ****************************
' Excel オブジェクト作成
' ****************************
Set App = CreateObject("Excel.Application")

' ****************************
' 警告を出さないようにする
' ****************************
App.DisplayAlerts = False

' ****************************
' ブック追加
' ****************************
App.Workbooks.Add()

' ****************************
' 追加したブックを取得
' ****************************
Set Book = App.Workbooks( App.Workbooks.Count )

' ****************************
' ブックにはシート一つ
' ****************************
Set Worksheet = Book.Worksheets( 1 )
Worksheet.Activate()
Call Book.Worksheets.Add(,Worksheet)

' ****************************
' シート名設定
' ****************************
Book.Sheets(1).Name = "新しい情報"
Book.Sheets(2).Name = "予備情報"

' ****************************
' 参照
' ****************************
FilePath = App.GetSaveAsFilename(,"Excel ファイル (*.xlsx), *.xlsx", 1)
if FilePath = "False" Then
	MsgBox "Excel ファイルの保存選択がキャンセルされました"
	Wscript.Quit()
End If

' ****************************
' 保存
' ****************************
on error resume next
Book.SaveAs( FilePath )
if Err.Number <> 0 then
	MsgBox( "ERROR : " & Err.Description )
end if
on error goto 0

' ****************************
' Excel をアプリケーションとして終了
' ****************************
App.Quit()

' ****************************
' Excel を VBScript から開放
' ****************************
Set App = Nothing

' ****************************
' オブジェクト変数を初期化
' ( 初期化しないとオブジェクト扱いされる )
' ****************************
App = Empty


MsgBox( "処理が終了しました" )

Microsoft ドキュメント

Application.GetSaveAsFilename メソッド (Excel)

Application.GetOpenFilename メソッド (Excel)

Worksheets.Add メソッド (Excel)


関連する記事

VBScript : 既存の Excel を PDF に変換する ( Excel 2007以降 )





タグ:VBScript EXCEL
posted by lightbox at 2018-05-27 01:20 | VBS + オブジェクト | このブログの読者になる | 更新情報をチェックする

2018年02月07日


VBScript : 複数テキストファイルの charset(キャラクタセット) 一括変換 / ADODB.Stream

ADODB.Stream を使用すると、テキストファイルのキャラクタセットををメモリ内で変換する事ができます

※ 変換元と変換後のキャラクタセットを指定する必要があります
※ ここでの対象ディレクトリはカレントにある "res" ディレクトリです
※ SaveToFile オプションの 2 は 上書きを意味します
Set Fso = CreateObject( "Scripting.FileSystemObject" )
Set Stream = CreateObject("ADODB.Stream")
Set Stream2 = CreateObject("ADODB.Stream")

Set objFolder = Fso.GetFolder( "res" )
Set objFiles = objFolder.Files

For each objFile in objFiles
	' フルパス
	strFullPath = Fso.GetAbsolutePathName( "res\" & objFile.Name )

	Stream.Open
	Stream.Type = 2		' StreamTypeEnum の adTypeText(デフォルト)
	Stream.Charset = "utf-8"
	Stream.LoadFromFile strFullPath
	Stream2.Open
	Stream2.Charset = "shift_jis"
	Stream.CopyTo Stream2
	Stream2.SaveToFile strFullPath, 2	' 上書き保存
	Stream2.Close
	Stream.Close

Next



Stream オブジェクト

関連するソースコード

VBScript でキャラクタセット変換



タグ:VBScript charset VBS
posted by lightbox at 2018-02-07 15:59 | VBS + オブジェクト | このブログの読者になる | 更新情報をチェックする

2017年12月25日


VBScript : 既存の Excel を PDF に変換する ( Excel 2007以降 )


2017/12/25 更新
Excel.Application を取得しているので、GetOpenFilename でファイルを選択できるようにしました。細かい詳細はソースコードにコメントに書き込んでいます

※ PDF は、Excel と同じ名前で拡張子を .pdf にしてスクリプトと同じフォルダに保存されます。
Excel 2007以降の Excelで名前を付けて保存で PDF に保存できますが、これはスクリプトで行うコードです。Excel 2007 を調べているとメソッド紹介されていたので、引数見た限り、 VBScriptでも動くだろうと試してみました。 ( プリンタが使える状態でないと動作しません ) ExportAsFixedFormat メソッド XlFixedFormatType 最近は、VBScript の単純コードである .vbs は Google Chrome での扱いが悪いので、.wsf で作成しています。もともと、.wsf のほうが簡単に外部ライブラリを参照したり、オブジェクトを最初から定義できるのでコードが簡潔になります。ここでは、Excel.Application 内で定義されている定数も参照して使えるようにしています。 Excel 側では、印刷設定により一行目のタイトルを常に表示するようにしたり、A4 横にして縮小したりしています。シートは二つありますが、PDF に変換すると全て出力されます。
<JOB>
<OBJECT id="Fso" progid="Scripting.FileSystemObject" />
<OBJECT id="ExcelApp" progid="Excel.Application" />
<REFERENCE guid="00020813-0000-0000-C000-000000000046" />
<SCRIPT language="VBScript">
' Wscript.Echo xlTypePDF,xlTypeXPS

' **************************************
' スクリプトのあるディレクトリの取得
' **************************************
strCurPath = WScript.ScriptFullName
Set obj = Fso.GetFile( strCurPath )
Set obj = obj.ParentFolder
strCurPath = obj.Path

' 途中で異常終了すると、Excel がプロセスに残ってしまうので表示させています。
' マウス等で Excel 本体を操作しないで下さい。
' Excel を表示させたくない場合は、以下を削除または行頭に ' でコメントにして下さい
ExcelApp.Visible = True

Dim MyBook
Dim FilePath

' ここで Excel を参照するダイアログが開きます
FilePath = ExcelApp.GetOpenFilename("Excel ファイル (*.xlsx;*.xls), *.xlsx;*.xls", 1, "Excel ファイルの選択") 
if FilePath = "False" Then 
	MsgBox "Excel ファイルの選択がキャンセルされました"
	' スクリプト終了
	Wscript.Quit()
End If

' ここで Excel に読み込んでいます
on error resume next
' Workbook を取得( スクリプトと同じディレクトリ )
Set MyBook = ExcelApp.Workbooks.Open( FilePath )
if Err.Number <> 0 then
	' 終了( 開放 )
	ExcelApp.Quit()
	Wscript.Echo Err.Description & vbCrLf & FilePath
	' スクリプト終了
	Wscript.Quit()
end if
on error goto 0

Dim aPath
Dim strFileName
Dim aExt

' Excel の名前部分を取り出して、pdf の名前部分にします
aPath = Split(FilePath, "\")
strFileName = aPath(Ubound(aPath))
aExt = Split(strFileName,".")
strFileName = aExt(0)

' スクリプトと同じフォルダに保存されます
Call MyBook.ExportAsFixedFormat( xlTypePDF, strCurPath & "\" & strFileName & ".pdf" )

' 終了( 開放 )
ExcelApp.Quit()

' 終了確認
Wscript.Echo "処理が終了しました"

</SCRIPT>
</JOB>


Microsoft の記事

Application.GetOpenFilename メソッド

Microsoft の英文の記事

Saving Workbooks to PDF and XPS Formats in Excel 2007




タグ:VBScript EXCEL PDF
posted by lightbox at 2017-12-25 17:27 | VBS + オブジェクト | このブログの読者になる | 更新情報をチェックする

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 + オブジェクト | このブログの読者になる | 更新情報をチェックする

2015年02月24日


VBScript : Access のテーブルを TransferText メソッドを使用して UTF-8 で CSV または HTML にして出力する



syain.html

Microsoft ドキュメント

DoCmd.TransferText メソッド

AcTextTransferType

サポートするコード ページ

概要

CSV と HTML で出力していますが、どちらも最後の引数にコードページを示す値で、UTF-8 を意味する 65001 をセットしています。そうすると、HTML では自動的に META 要素に UTF-8 が設定されて、ファイルは UTF8N になります。CSV もまた UTF8N で出力されます。

最初の引数で、エクスポートタイプを指定していますが、本来定数定義されているタイプライブラリを GUID で参照してそのまま使用しています。

GUID は、OLE-COM Object Viewer(Visual Studio 2010) で、Type Libraries ツリーより Microsoft Access 14.0 Object Library を開いて 取得しています。
<JOB>
<OBJECT id="Acc" progid="Access.Application" />
<OBJECT id="Fso" progid="Scripting.FileSystemObject" />
<REFERENCE guid="4AFFC9A0-5F99-101B-AF4E-00AA003F0F07" />
<SCRIPT language="VBScript">
' **************************************
' スクリプトのあるディレクトリの取得
' **************************************
strCurPath = WScript.ScriptFullName
Set obj = Fso.GetFile( strCurPath )
Set obj = obj.ParentFolder
strCurPath = obj.Path

Acc.OpenCurrentDatabase( strCurPath & "\社員マスタ.accdb") 

Acc.docmd.TransferText acExportDelim, "", "社員マスタ", strCurPath & "\syain.csv", true, "", 65001
Acc.docmd.TransferText acExportHTML, "", "社員マスタ", strCurPath & "\syain.html", true, "", 65001

Acc.docmd.Closedatabase

' 終了確認
Wscript.Echo "処理が終了しました"

</SCRIPT>
</JOB>

ファイルのバスの後の True は、1 行目をフィールド名として使用すると言う意味です。。テキスト ファイルの 1 行目をデータとして処理する場合は、False (0) を使います。この引数を指定しないと、False (既定値) が使われます。


タグ:VBScript access
posted by lightbox at 2015-02-24 21:17 | VBS + オブジェクト | このブログの読者になる | 更新情報をチェックする

2014年08月13日


VBScript : ネイティブ(CAPICOM.Utilities) Base64 エンコード

Stream オブジェクトと併用するのがミソです。この場合、Shift_JIS の文字列を Base64 に変換します。

Microsoft のドキュメント

Utilities Object (Windows)

関連する記事

VBScript : ネイティブ SHA1、MD5、SHA256 変換
Set CAPIUtil = CreateObject( "CAPICOM.Utilities" )
Set Stream = CreateObject("ADODB.Stream")
Set StreamBin = CreateObject("ADODB.Stream")

'******************************
' Base64 エンコード
'******************************
Stream.Open
Stream.Charset = "shift_jis"
' shift_jis で入力文字を書き込む
Stream.WriteText "日本語表示OK"
Stream.Position = 0

' バイナリで開く
StreamBin.Open
StreamBin.Type = 1

' テキストをバイナリに変換
Stream.CopyTo StreamBin
Stream.Close

' 読み込みの為にデータポインタを先頭にセット
StreamBin.Position = 0

' 変換
strBinaryString = CAPIUtil.ByteArrayToBinaryString( StreamBin.Read )
strBase64 = CAPIUtil.Base64Encode( strBinaryString )
' 長い文字列は仕様として、(\r\n を含めて 76) 改行されます
strBase64 = Replace(strBase64,vbCrLf,"")

Wscript.Echo strBase64



タグ:Base64 CAPICOM
posted by lightbox at 2014-08-13 23:32 | VBS + オブジェクト | このブログの読者になる | 更新情報をチェックする
Seesaa の各ページの表示について
Seesaa の 記事がたまに全く表示されない場合があります。その場合は、設定> 詳細設定> ブログ設定 で 最新の情報に更新の『実行ボタン』で記事やアーカイブが最新にビルドされます。

Seesaa のページで、アーカイブとタグページは要注意です。タグページはコンテンツが全く無い状態になりますし、アーカイブページも歯抜けページはコンテンツが存在しないのにページが表示されてしまいます。

また、カテゴリページもそういう意味では完全ではありません。『カテゴリID-番号』というフォーマットで表示されるページですが、実際存在するより大きな番号でも表示されてしまいます。

※ インデックスページのみ、実際の記事数を超えたページを指定しても最後のページが表示されるようです

対処としては、このようなヘルプ的な情報を固定でページの最後に表示するようにするといいでしょう。具体的には、メインの記事コンテンツの下に『自由形式』を追加し、アーカイブとカテゴリページでのみ表示するように設定し、コンテンツを用意するといいと思います。


※ エキスパートモードで表示しています

アーカイブとカテゴリページはこのように簡単に設定できますが、タグページは HTML 設定を直接変更して、以下の『タグページでのみ表示される内容』の記述方法で設定する必要があります

<% if:page_name eq 'archive' -%>
アーカイブページでのみ表示される内容
<% /if %>

<% if:page_name eq 'category' -%>
カテゴリページでのみ表示される内容
<% /if %>

<% if:page_name eq 'tag' -%>
タグページでのみ表示される内容
<% /if %>
この記述は、以下の場所で使用します
container 終わり

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

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