Excelの印刷ツールです。
インストール方法 †

実行すると、右クリック時の送るに自分自身のショートカットを作成します。
↑
使い方 †

印刷したいExcelファイルを選択し、右クリックの送るでスクリプトを起動する そうすると、すべてのシートの内容を印刷する。 （複数ファイル対応）
↑
プログラム †

	'-------------------------------
	'右クリックでEXCEL印刷プログラム
	'2007/04/20 ver 1.0
	'2008/07/11 ver 1.1 sort追加
	'-------------------------------
	Option Explicit
	Const CNS_DSPLOG = True		'ログ表示
	Const CNS_DEBUGLOG = False	'デバッグログ表示
	Const cnsVer = "Ver1.1"
	Call Main()

	WScript.Quit(0)

	'-------------------------------
	'メイン
	'-------------------------------
	Sub Main()
		Dim objFS
		Dim objArgs
		Dim idx
		Dim strFName
		Dim strMsg
		Dim ret

		Set objArgs = WScript.Arguments
		Set objFS = CreateObject("Scripting.FileSystemObject")

		If objArgs.Count = 0 Then
			'パラメータ無しなら「右クリック送る」に自分自身をコピーする。
			Call CopySendTo()
		Else
			'実行確認
			strMsg = ""

			'パラメータから配列に
			ReDim aryArg( objArgs.Count - 1 )
			For idx = 0 to  objArgs.Count - 1
				aryArg(idx) = objArgs(idx)
			Next
			'ファイル名順にソート
			Call SortAry(aryArg)
			
			'ファイル名確認メッセージボックス
			For idx = 0 to  Ubound(aryArg)
				strFName = aryArg(idx)
				strMsg = strMsg & strFName & vbCrLf
			Next 
			strMsg = strMsg & "印刷します。　よろしいですか？"
			ret = MsgBox( strMsg , vbOkCancel + vbDefaultButton1, WScript.ScriptName & " " & cnsVer)

			'OKなら印刷
			If ret = vbOk Then
				'印刷する
				For idx = 0 to Ubound(aryArg)
					strFName = aryArg(idx)
					Call DebugLog( strFName )
					If objFs.FileExists(strFName) = True Then
						If UCase( objFS.GetExtensionName(strFName) ) = "XLS" Then 
							'XLSファイルが存在するならExcel印刷
							Call ExcelPrint(strFName)
						Else
							Call Msgbox(strFName & vbCrLf & "エクセルファイルではありません",, WScript.ScriptName & " " & cnsVer)
						End If
					End If
				Next 
				Call MsgBox("印刷が完了しました。",,WScript.ScriptName & " " & cnsVer)
			End If
		End If

		Set objFS = Nothing 
		Set objArgs = Nothing 
	End Sub

	'/////////////////////////////////////////////////
	'その他サブルーチン
	'/////////////////////////////////////////////////
	'シートの印刷
	Sub ExcelPrint(FNAME)
		Dim wBook, wSheet
		Call DebugLog( FNAME )
		Set wBook = GetObject(FNAME)
		'--wBook.Application.Visible = True
		'--wBook.Activate
			
		'--マクロの動作をさせない
		'--WScript.Shell.Sleep 2000
		'--WScript.Shell.SendKeys "{SPACE}"
		
		'--AcitveSheetの印刷
		'--Set wSheet = wBook.ActiveSheet
		'--wSheet.PrintOut
		
		'--ブックのすべてを印刷する
		wBook.Worksheets.PrintOut		'ブックのすべてを印刷する
		WScript.Sleep(500)
		wBook.Close(False)	'Not Save Change
		WScript.Sleep(500)
		Set wBook=Nothing
	End Sub

	Sub CopySendTo()
		'パラメータ無しで実行した場合はSendToに自分自信を作成する。
		Dim objWshShell, objFS
		Set objWshShell = CreateObject("WScript.Shell")
		Set objFS = CreateObject("Scripting.FileSystemObject")
		objFS.CopyFile WScript.ScriptFullName , objWshShell.SpecialFolders("SendTo") & "\" & WScript.ScriptName
		Call MsgBox("右クリック-「送る」に " & WScript.ScriptName & " をコピーしました。",,WScript.ScriptName & " " & cnsVer)
		Set objWshShell = Nothing 
		Set objFS = Nothing 
	End Sub

	Sub PutLog(Msg)
		Dim strMsg
		strMsg = Now & vbTab & Msg
		If CNS_DSPLOG = True Then
			Wscript.Echo(strMsg)
		End if 
	End Sub

	Sub DebugLog(Msg)
		If CNS_DEBUGLOG = True Then
			Call PutLog(Msg)
		End if 
	End Sub

	'/////////////////////////////////////////////////
	'配列のソート
	'/////////////////////////////////////////////////
	Sub SortAry(aryWk)
		Dim strWork
		Dim idx,idy,idz
		For idx = 0 to Ubound(aryWk)
			idz = idx
			strWork = aryWk(idx)
			For idy = idx + 1 to  Ubound(aryWk)
				If aryWk(idy) < strWork Then
					strWork = aryWk(idy)
					idz = idy
				End If
			Next
			aryWk(idz) = aryWk(idx)
			aryWk(idx) = strWork
		Next
	End Sub