Shapeの内容を出力するスクリプト

ExcelShapesOutput.vbs

'--------------------------------------------------------------------------------------
'
'	Excel Shapes 出力
'			(指定したフォルダにあるExcelファイルのShapeオブジェクトの情報を出力する)
'	
'	注意点	スクリプト実行前にすべてのExcelアプリケーションを終了してください。
'			スクリプト実行中はマウス、キーボードを使用しないでください。
'			このスクリプトが異常終了した場合はExcelのプロセスを手動で終了してください。
'			GroupShapeがネストしているケースは未対応(そんなことはあるのか？)
'--------------------------------------------------------------------------------------

targetPath = InputBox("出力対象のディレクトリを入力","ディレクトリの指定","")

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

else

	'このディレクトリのファイル一覧を取得する
	Set fileSystem   = CreateObject("Scripting.FileSystemObject")
	Set targetFolder = fileSystem.getFolder(targetPath)
	Set fileList = targetFolder.Files

	'結果を出力するファイルを作成する
	Set resultfile = fileSystem.CreateTextFile(targetPath & "\" & "result.txt",True)

	'ヘッダを出力
	call propatetyHeaderOutput()


	'ファイルの終端までループ
	For Each wkFile In fileList

		'対象ファイルがExcelならExcelで開く
		if wkFile.type = "Microsoft Excel ワークシート" then

			Set Excel  = CreateObject("Excel.Application")

			Set wkBook = Excel.WorkBooks.Open(wkFile)
			
			'シートの数ループする
			For i = 1 to wkBook.WorkSheets.Count
				
				Set xlsSheet = wkBook.WorkSheets(i)

				'Shapesオブジェクトのループ
				For j = 1 to wkBook.WorkSheets(i).Shapes.Count

					Set wkShape = xlsSheet.Shapes(j)

					'プロパティを出力
					Call propatetyOutput(wkBook.name,xlsSheet.Name,wkShape)

					'GroupShapeの場合、そのメンバを取得
					If wkShape.Type = 6	Then

						For k = 1 to wkShape.GroupItems.Count
							
							'プロパティを出力
							Call propatetyOutput(wkBook.name,xlsSheet.Name,wkBook.WorkSheets(i).Shapes(j).GroupItems(k))

						Next

					End if

				Next

			Next

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

		end if

	Next

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

end if

'--------------------------------------------------------------------------------------
'
'	propatety名(ヘッダ)をカンマ区切で出力する
'
'--------------------------------------------------------------------------------------
Sub propatetyHeaderOutput()
	
	resultVal = ""

	resultVal = resultVal & "BookName"					& ","
	resultVal = resultVal & "SheetName"					& ","

	resultVal = resultVal & "Name"						& ","
	resultVal = resultVal & "AlternativeText"			& ","
	resultVal = resultVal & "Height"					& ","
	resultVal = resultVal & "Width"						& ","
	resultVal = resultVal & "Left"						& ","
	resultVal = resultVal & "Top"						& ","


	resultfile.WriteLine resultVal

End Sub

'--------------------------------------------------------------------------------------
'
'	propatetyをカンマ区切で出力する
'
'--------------------------------------------------------------------------------------
Sub propatetyOutput(bookName,sheetName,paraShape)
	
	resultVal 	= ""
	resultText	= ""

	'改行コードを除去
	resultText	=	paraShape.AlternativeText
	resultText	=	replace(resultText,Chr(10),"")

	'
	resultVal = resultVal & bookName									& ","
	resultVal = resultVal & sheetName									& ","

	resultVal = resultVal & paraShape.Name								& ","
	resultVal = resultVal & resultText									& ","
	resultVal = resultVal & paraShape.Height							& ","
	resultVal = resultVal & paraShape.Width								& ","
	resultVal = resultVal & paraShape.Left								& ","
	resultVal = resultVal & paraShape.Top								& ","


	resultfile.WriteLine resultVal

End Sub