ソース掲示板




すべてから検索

キーワード   条件 表示 現行ログ 過去ログ トピックス 名前 本文

  メンテナンス 前画面に戻る

対象スレッド 件名: Excelに書かれたデータを元に画像を加工する
名前: lightbox
処理選択
パスワード

件名 Excelに書かれたデータを元に画像を加工する
名前 lightbox
コメント
@DIV
' リサイズ用コードサンプル
' Call img.Convert("image.tif", "-resize", "800", "work.bmp")
'
' 実サイズの標準値( ミリ )
nRealWidth = 251
nRealHeight = 181

Set fso = CreateObject("Scripting.FileSystemObject")
Set img = CreateObject("ImageMagickObject.MagickImage.1")


Dim Book ' 一つのブックを処理するインスタンス

Set Book = New ExcelAction
Call Book(ExcelApp,"パラメータのあるExcelのフルパス")

' デフォルトが非表示なので表示
Book.Visible( True )

' 二つ目のシートを使用する
Book.SelectSheetNo( 2 )

str = Book.GetCellActive(7,3)
n1 = CLng(str)
str = Book.GetCellActive(8,3)
n2 = CLng(str)

Book.Quit()

' 全てのプックを閉じてから、いずれかのインスタンスで終了する
' ブックが一つの場合は、閉じる必要は無い( 閉じてから終了 )

Call CropImage( "元画像.拡張子", n1, n2 )

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


Function CropImage( strFileName, nRight, nLeft  )
' 右からの切り取り位置
' 左からの切り取り位置

	Dim pic,aData

	aData = Split( strFileName, "," )

	' BMP化( 参考データ : 3872 x 2688 )
	Call img.Convert(strFileName, "work.bmp")

	Set pic = LoadPicture("work.bmp")

	nWidth = CLng(CLng(pic.Width) * 567 / 15000)
	nHeight = CLng(CLng(pic.Height) * 567 / 15000)

	Set pic = Nothing
	pic = Empty

	' 画像上の右からの切り取り位置
	nCrop1 = CLng(nWidth*nRight/nRealWidth)
	sParam1 = nCrop1 & "x" & nHeight & "+" & ( nWidth - nCrop1 ) & "+0"

	Call img.Convert( _
		"work.bmp", _
		"-crop", _
		sParam1, _
		"+repage", _
		aData(0)&"-h.png" )


	' 画像上の左からの切り取り位置
	nCrop2 = CLng(nWidth*nLeft/nRealWidth)
	sParam2 = nCrop2 & "x" & nHeight & "+0+0"

	Call img.Convert( _
		"work.bmp", _
		"-crop", _
		sParam2, _
		"+repage", _
		aData(0)&"-f.png" )


	' 画像上の中央の切り取り位置
	sParam3 = nWidth-nCrop2-nCrop1 & "x" & nHeight & "+" & nCrop2 & "+0"

	Call img.Convert( _
		"work.bmp", _
		"-crop", _
		sParam3, _
		"+repage", _
		aData(0)&"-b.png" )

End Function

' ************************************************
' クラス定義
' ************************************************
Class ExcelAction

	Public ExcelApp		' 共有
	Public ExcelBook	' このインスタンス用

' ************************************************
' コンストラクタのようなもの( New では呼ばれない )
' ************************************************
	Public Default Function InitSetting(ExcelApp,strPath)

		If Not IsObject(ExcelApp) Then
			Set Me.ExcelApp = CreateObject("Excel.Application")
		else
			Set Me.ExcelApp = ExcelApp
		End If
		Set ExcelApp = Me.ExcelApp

		Set ExcelBook = ExcelApp.Workbooks.Open(strPath)

		' アクティブなウィンドウを最大化
		ExcelApp.ActiveWindow.WindowState = 2
		' 警告メッセージを非表示
		ExcelApp.DisplayAlerts = False

	end function
 
' ************************************************
' メソッド ( 表示・非表示の設定 )
' ************************************************
	Public Function Visible(bFlg)
	
		Me.ExcelApp.Visible = bFlg
	
	End Function

' ************************************************
' Book を閉じる
' ************************************************
	Public Function Close()
	
		If TypeName(ExcelBook) = "Workbook" Then
			' 保存した事にする
			ExcelBook.Saved = True
		End If
		ExcelBook.Close()
		Set ExcelBook = Nothing
		ExcelBook = Empty
	
	End Function

' ************************************************
' Excel 本体の終了
' ************************************************
	Public Function Quit()

		If IsObject(ExcelBook) Then
			If TypeName(ExcelBook) = "Workbook" Then
				' 保存した事にする
				ExcelBook.Saved = True
			End If
		End if
		If IsObject(ExcelApp) Then
			ExcelApp.Quit
			Set ExcelApp = Nothing
		End If
		ExcelApp = Empty

	End Function

' ************************************************
' シート名によるシート選択
' ************************************************
	Public Function SelectSheet(strSheetName)

		ExcelBook.Sheets(strSheetName).Select

	End Function

' ************************************************
' 番号よるシート選択
' ************************************************
	Public Function SelectSheetNo(No)

		ExcelBook.Sheets(No).Select

	End Function

' ************************************************
' セルへのデータセット
' ************************************************
	Public Function SetCell(strSheetName, x, y, Data)

		ExcelBook.Sheets(strSheetName).Cells(y, x) = Data

	End Function
	Public Function SetCellActive(x, y, Data)

		ExcelBook.ActiveSheet.Cells(y, x) = Data

	End Function

' ************************************************
' セルからデータの取得
' ************************************************
	Public Function GetCell(strSheetName, x, y)

		GetCell = ExcelBook.Sheets(strSheetName).Cells(y, x)

	End Function
	Public Function GetCellActive(x, y)

		GetCellActive = ExcelBook.ActiveSheet.Cells(y, x)

	End Function

End Class
@END