列折り返しツール

Excelを規定した列ごとに折り返すツール。

データのダンプをExcelに貼り付けて保存する場合に項目数が多いと
印刷時に改ページされて印刷枚数が増えるので、折り返して印刷枚数を減らすのを目的に作成。

'--------------------------------------------------------------------------------------
'
'	Excel 折り返しツール
'			(指定ファイルを定義した列数ごとに折り返す)
'	
'	注意点	スクリプト実行前にすべてのExcelアプリケーションを終了してください。
'			スクリプト実行中はマウス、キーボードを使用しないでください。
'			このスクリプトが異常終了した場合はExcelのプロセスを手動で終了してください。
'			データは１行目から入力してください。
'
'--------------------------------------------------------------------------------------

'パラメータの受取(ファイルのドラッグ&ドロップで可)
If WScript.Arguments.Count > 0 Then

	targetPath = WScript.Arguments(0)

End if

'パラメータがない場合、ダイアログで入力を促す
if targetPath = "" then

	targetPath = InputBox("処理対象のファイルを入力","ファイルの指定","")

end if



if targetPath = "" then
	
	msgbox "出力を中止しました。"

else

Const MAX_COLUMN = 10			'折り返しを行う列数
Const EXCEL_EXT  = ".xls"		'拡張子

	Set Excel  = CreateObject("Excel.Application")

	Set wkBook = Excel.WorkBooks.Open(targetPath)

	'最後のシートまでループ
	For wkSheetCnt = 1 To wkBook.Sheets.Count

		Set xlsSheet = wkBook.WorkSheets(wkSheetCnt)

		Call DumpFormat(xlsSheet)

		Set xlsSheet = Nothing

	Next


	'ファイルを別名で保存
	wkBook.SaveAs replace(targetPath,EXCEL_EXT,"") & "_format" & EXCEL_EXT

	'Excelを終了する。
	wkBook.Close
	Excel.Quit



	msgbox "出力を完了しました。"

end if


function DumpFormat(xlsSheet)

Dim wkRow
Dim wkDataCnt

Const xlCellTypeLastCell = 11


	xlsSheet.Activate
	wkRow = 1
	wkDataCnt = xlsSheet.Cells.SpecialCells(xlCellTypeLastCell).Row

	For i = 1 To 256 Step MAX_COLUMN

		IF xlsSheet.Cells(1,i) <> "" AND i > 1 THEN

			wkRow = wkRow	+	wkDataCnt + 1

			xlsSheet.Range(xlsSheet.Cells(1,i),xlsSheet.Cells(wkDataCnt,i + MAX_COLUMN -1)).Cut
			xlsSheet.Range(xlsSheet.Cells(wkRow,1),xlsSheet.Cells(wkRow,1)).Select
			xlsSheet.Paste

		END IF

	Next

end function

動作確認環境:Excel 2007,Window XP sp2