Libre Calc Macro : 古い画像を削除する(Image Cleaner)

Libre Calc

「Libre Calc Macro:画像をセルで登録管理する」と同様に画像管理のためのモジュールです。
前回は画像をセルで管理するためのモジュールを設計しましたが、今回はその逆。
指定日より古い日付の画像を削除します。

■ モジュールの機能

指定された日付より古い行と張り付けられたイメージを削除します。
イメージをセルに張り付けて管理すると、面倒なのは、不要なイメージの削除となります。
不要な行と、画像を一緒に削除します。

■ サンプルコード

原理は、「Libre Calc Macro:画像をセルで登録管理する」で、イメージのアンカーを特定セルに設定しました。
本Basicマクロは、アンカーを頼りにイメージを削除します。
サンプルコードでは、最初に不要行を見つけた後、不要行にアンカー設定しているイメージを検索、削除します。
この辺りを調べても、あまり情報が出てこなかったので、デバッガを頼りに探りました。(緑部)

'
'	コンフィグレーション
'
Private const cnf_sheet_list	= "撮影画像"	' 画像登録シート
Private const cnf_row_latest	= 1		' 最新画像挿入行
Private const cnf_col_date_time	= 0		' 日付入力カラム
Private const cnf_col_event	= 1		' イベント入カラム
Private const cnf_col_image	= 2		' イメージ入力カラム
Private const cnf_list_height	= 5000		' 5cm

'
'	purpose	:	指定された日付以前の画像とリストを削除する
'
public function cam_image_clean(target as date) as integer
	Dim numline as integer
	Dim row as integer
	Dim nshape as integer
	Dim tagetcell as string
	Dim sheet as object
	Dim range as object
	Dim cursor as object
	Dim dp as Object
	Dim shape as Object
	
	'
	'	操作対象の使用ライン数を取得する
	'
	sheet = ThisComponent.Sheets.getbyname(cnf_sheet_list)
	range = sheet.getCellRangeByName("A1")
	cursor = sheet.createCursorByRange(range)
	cursor.gotoEndOfUsedArea(true)
	numlines = cursor.Rows.Count
	
	'
	'	対象シートの最終行から対象行を検索する
	'
	dp = sheet.getDrawPage()
	for row = numlines - 1 to cnf_row_latest step -1
		if (DateValue(sheet.getCellByPosition(cnf_col_date_time, row).String) < target) then
			targetcell = "$" & cnf_sheet_list & ".$C$" & (row+1)
			for nshape = dp.getcount - 1 to 0 step -1
				shape = dp.getByIndex(nshape)
				if (shape.Anchor.AbsoluteName = targetcell) then
					dp.remove(shape)
				end if
			next
		
			sheet.getRows.removeByIndex(row, 1)
		end if
	next
	
	cam_image_clean = 0
end function

'
'	画像削除テスト
'
sub test_clean()
	call cam_image_clean(dateadd("d", -1,  DateValue(Now())))
end sub

test_clean()を実行すると、1日前以上古い行とイメージを削除します。

■ サンプルコード

上記で使用したサンプルプログラムです。
なお、テスト用に「Libre Calc Macro:画像をセルで登録管理する」のマクロも同梱しています。
自己責任での御使用をお願いいたします。

タイトルとURLをコピーしました