Excel の処理 ( VBScript のクラス )

  目次







  定数



  
Const xlContinuous = 1
Const xlDash = -4115
Const xlDashDot = 4
Const xlDashDotDot = 5
Const xlDot = -4118
Const xlDouble = -4119
Const xlSlantDashDot = 13
Const xlLineStyleNone = -4142

Const xlHairline = 1
Const xlMedium = -4138
Const xlThick = 4
Const xlThin = 2

Const xlInsideHorizontal = 12
Const xlInsideVertical = 11
Const xlDiagonalDown = 5
Const xlDiagonalUp = 6
Const xlEdgeBottom = 9
Const xlEdgeLeft = 7
Const xlEdgeRight = 10
Const xlEdgeTop = 8

Const xlAutomatic = -4105

Const xlMaximized = -4137
Const xlMinimized = -4140
Const xlNormal = -4143
  



  ブックを処理するクラス

ソースが見づらくなるので、エラー処理は完全ではありません

  
Class CExcel

Public App
Public WshShell
Public ErrDescription
Private WorkBook
Public CurBook

' ************************************************
' インスタンスが作成されたときの処理
' ************************************************
	Private Sub Class_Initialize()

		Call InitSetting()

	End Sub

' ************************************************
' インスタンスが終了したときの処理
' ( Set インタンス変数 = Nothing で発生 )
' ************************************************
	Private Sub Class_Terminate()

		Call Quit()

	End Sub

' ************************************************
' 初期処理
' ************************************************
	Public Default Function InitSetting()

		if IsEmpty( App ) then
			Set App = CreateObject("Excel.Application")
		end if 
		if IsEmpty( WshShell ) then
			Set WshShell = CreateObject("WScript.Shell")
		end if 

		' ユーザーに入力を促すメッセージを表示させないようにする
		App.DisplayAlerts = False

		Set CurBook = Nothing

	end function

' ************************************************
' 終了
' ************************************************
	Public Function Quit()

		If not IsEmpty( App ) Then
			For Each Workbook In App.Workbooks
				' 全てのブックを保存した事にする
				WorkBook.Saved = True
			Next
			App.Quit
			Set App = Nothing
			App = Empty
			Set CurBook = Nothing
		End If

	End Function

' ************************************************
' 表示・非表示
' ************************************************
	Public Property Let Visible( bFlg )
		App.Visible = bFlg
	End Property 
	Public Property Get Visible
		Visible = App.Visible
	End Property

' ************************************************
' 開く
' ************************************************
	Public Function Open( strPath )

		on error resume next
		Set Open = App.Workbooks.Open(strPath)
		if Err.Number <> 0 then
			Set Open = Nothing
			ErrDescription = Err.Description
			Exit Function
		end if
		on error goto 0
		Set CurBook = Open

		' アクティブなウィンドウを最大化
		App.ActiveWindow.WindowState = xlMaximized

	End Function

' ************************************************
' 新規ブック作成
' ************************************************
	Public Function Create( strPath )

		Dim nBooks

		App.Workbooks.Add
		nBooks = App.Workbooks.Count
		Set Create = App.Workbooks( nBooks )
		Set CurBook = Create
		CurBook.Activate

		' アクティブなウィンドウを最大化
		App.ActiveWindow.WindowState = xlMaximized

		if strPath <> "" then
			on error resume next
			CurBook.SaveAs( strPath )
			if Err.Number <> 0 then
				MsgBox( Err.Description )
				Exit Function
			end if
			on error goto 0
		end if

	End Function

' ************************************************
' 閉じる
' ************************************************
	Public Function Close( MyBook )

		if IsObject( MyBook ) then
			MyBook.Saved = True
			MyBook.Close
			Set MyBook = Nothing
			MyBook = Empty
		else
			if CurBook is Nothing then
			else
				CurBook.Saved = True
				CurBook.Close
				Set CurBook = Nothing
			end if
		end if

	End Function

' ******************************************************
' 上書き保存
' ******************************************************
	Function Save( MyBook )

		if IsObject( MyBook ) then
			MyBook.Save
		else
			CurBook.Save
		end if

	End Function

' ******************************************************
' 名前を付けて保存
' ******************************************************
	Function SaveAs( MyBook, strPath )

		if IsObject( MyBook ) then
			MyBook.SaveAs strPath
		else
			CurBook.SaveAs strPath
		end if

	End Function

' ******************************************************
' LOAD
' ******************************************************
	Function Load( strPath )

		if not IsEmpty( App ) then
			MsgBox( "Excel をロードする前に、Quitを実行して下さい   " )
			Exit Function
		end if

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

	End Function

End Class
  



  Class_Initialize と Class_Terminate

それぞれ、インスタンスが作成された時と、明示的に終了した場合( Nothing をセット )に呼び出されます

  
Private Sub Class_Initialize()

	Call InitSetting()

End Sub

Private Sub Class_Terminate()

	Call Quit()

End Sub
  

インスタンス作成
  
Dim MyExcel

Set MyExcel = new CExcel
  

インスタンス終了
  
Set MyExcel = Nothing
  



  オブジェクトの初期処理 ( InitSetting )

Excel を処理するのに必要なオブジェクトの初期設定を行います
( Class_Initialize より呼び出されます )

Default の Function として定義されているので、オブジェクト名で Call できます
( いったん Quit を実行した後、Excel処理を再開する場合に呼び出す必要があります )

  
MyExcel.Quit
MyExcel.Load( "ブックのパス" )
Call MyExcel()
  



  表示・非表示 ( Visible プロパイティ )

内部 Excel アプリケーションオブジェクトの Visible プロパティを設定または取得します

  
MyExcel.Visible = True
  



  ブックを開く ( Open )

既存のブックを開きます
正常に開かれた場合は、Workbook オブジェクトの参照を戻します
エラーの場合は Nothing が返り、ErrDescription メンバ変数にエラーメッセージがセットされます

※ 一つのブックしか開かない場合は、戻り値を取得しなくても CurBook メンバ変数を使用できます

  
Dim Workbook

Set Workbook = MyExcel.Open( "ブックのパス" )
if Workbook is Nothing then
	MsgBox( MyExcel.ErrDescription )
	Workbook = Empty
end if
  



  新規ブック作成 ( Create )

新しいブックを作成します。( Sheet1,Sheet2,Sheet3 が作成されます )
引数にパスを指定すると、即保存されます
"" を指定すると、ファイルとして保存されません

※ 戻り値に関しては Open と同じですが、Nothing になる事はありません
( 保存時エラーでは MsgBox が表示されます )

  
Set Workbook = MyExcel.Create("ブックのパス")
Set Workbook = MyExcel.Create("")
  



  終了 ( Quit )

Excel アプリケーションを終了させて、メモリから解放します
※ Quit 実行後即時にプロセスが終了しません( タイムラグがあります )

この際、変更されたブックは保存しません

※ 再度処理を行なう場合は Call MyExcel() を実行して下さい

  
MyExcel.Quit
  










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




SQLの窓  天気  IT用語辞典
Yahoo!ニュース  マルチ辞書
PHP マニュアル  Google URL短縮 


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

SQLの窓フリーソフト

素材

一般WEBツールリンク

SQLの窓

フリーソフト

JSライブラリ