Libre Calc Macro ： シートで画像管理する(Image Register)

必要に迫られて、画像をセルに張り付けて管理するモジュールを作ってみました。
Libre Calcで実現しようとして、調べたり、試作したりと、結構な難易度だったので、備忘録として残しています。

■ モジュールの機能

作成するマクロは、下記のことを実施します。
テスト時の画面で動作イメージがわくと思いましたので添付しました。

① テストマクロを実行し、画像ファイルを指定すると、下記のようにリストを先頭行に挿入します。
② 挿入行のセル高を5cmに変更し、セルに画像を張り付けます。（アンカーもセルに固定）
③ セルの高さに合わせて、画像サイズを調整します。
④ 挿入日時をセルに記録します。
⑤ イベント(ここでは”test”)を記録します。

機能を実現する際に気を付けたいのは、イメージのアンカー。
イメージのアンカーをセルに設定しているので、行挿入するとイメージも勝手にずれてくれます。
また、別途、古いイメージを削除するマクロを用意しますが、機能実現のポイントにもなります。

■ サンプルコード

マクロはすべて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	:	イメージをシートに登録する
'	returns	:	0
'
public function cam_image_register(event as string, path as string) as integer
	Dim sheet as object
	Dim size as new com.sun.star.awt.Size
	Dim document   as object
	Dim dispatcher as object
	Dim imgargs(1) as new com.sun.star.beans.PropertyValue


	'
	'	ドキュメント、ディスパッチャー	の取得
	'	
	document   = ThisComponent.CurrentController.Frame
	dispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
	
	
	'
	'	登録用の行を追加
	'
	sheet = ThisComponent.Sheets.getbyname(cnf_sheet_list)
	sheet.getRows.insertByIndex(cnf_row_latest, 1)
	sheet.getRows.getByIndex(cnf_row_latest).Height = cnf_list_height
	
	'
	'	イメージ登録位置を選択
	'
	ThisComponent.CurrentController.Select(Sheet.getCellByPosition(cnf_col_image, cnf_row_latest))
		
	'
	'	イメージ挿入（デフォルトでアンカーは選択したセルにセットされることを期待）
	'
	imgargs(0).Name = "FileName"
	imgargs(0).Value = ConvertToURL(Path)
	imgargs(1).Name = "AsLink"
	imgargs(1).Value = false
	dispatcher.executeDispatch(document, ".uno:InsertGraphic", "", 0, imgargs())
	
	'
	'	イメージをセルサイズにあわせてリサイズを行う
	'
	dp = sheet.getDrawPage()
	shape = dp.getByIndex(dp.getcount - 1)
	size.Height =  ThisComponent.CurrentController.selection.Size.Height
	size.Width = shape.Size.Width * size.Height / shape.Size.Height
	shape.Size = size
	
	'
	'	日付の記録
	'
	sheet.getCellByPosition(cnf_col_date_time, cnf_row_latest).String = DateValue(date) + TimeValue(time)
	
	'
	'	イベントの記録
	'
	sheet.getCellByPosition(cnf_col_event, cnf_row_latest).String = event

	cam_image_register = 0
end function

'
'	画像挿入テスト
'
sub test()
	Dim fp as Object
	
	fp = CreateUnoService("com.sun.star.ui.dialogs.FilePicker")
	If (fp.Execute() = 1) then
		call cam_image_register("test", fp.Files(0))
	End If
End Sub

■ サンプルプログラム

上記で使用したサンプルプログラムです。
自己責任での御使用をお願いいたします。