946.BLOG

みようみまねで OpenOffice.org 用に
表示されるダイアログで選択した画像を
セルの選択範囲に合わせたサイズで埋め込むマクロをかいてみた。

ちょっとしたテンプレートを用意して
ツールバーに登録しちゃえば
ちょっとしたアルバム？作りに便利かも。

'セルの選択範囲に合わせたサイズで画像を埋め込む
'本家			http://docs.sun.com/app/docs/doc/819-1332/faaim?a=view
'画像の埋め込み	http://hermione.s41.xrea.com/pukiwiki/index.php?OOoBasic%2FDraw%2FShapes
'画像サイズ		http://hermione.s41.xrea.com/pukiwiki/pukiwiki.php?OOoBasic%2FGeneric%2FImage
sub InsFitP
	'範囲の取得
	dim oDoc	as object
	dim oRange	as object

	oDoc = StarDesktop.CurrentComponent	'このコードを実行しているドキュメントを返す
	oRange = oDoc.CurrentSelection
	If not oRange.supportsService("com.sun.star.sheet.SheetCellRange") Then exit sub

	'ダイアログを利用して画像ファイルの URL を取得
	dim oDlg		as object
	dim sFiles()	as string
	dim	sURL		as string

    oDlg = createUnoService("com.sun.star.ui.dialogs.FilePicker")
    with oDlg
'	    .SetDisplayDirectory = "C:\"
'		.SetDefaultName = "hehe"
    	.AppendFilter("JPEG (*.jpg,*.jpeg)", "*.jpg", "*.jpeg")
		.AppendFilter("すべてのファイル", "*.*")
	end with
	if 1 <> oDlg.Execute then
		oDlg = Nothing
		exit sub
	endif
	sFiles = oDlg.getFiles()
	sURL = sFiles(0)
'	msgbox ConvertFromURL(sURL)

	'画像の読み込みとサイズの取得
	dim oGP			as object
	dim aArgs(0)	as new com.sun.star.beans.PropertyValue
	dim oG			as object
	dim aSize		as new com.sun.star.awt.Size	'aSize = createUnoStruct("com.sun.star.awt.Size") でも可

	oGP = createUnoService("com.sun.star.graphic.GraphicProvider")
	aArgs(0).Name = "URL"
	aArgs(0).Value = sURL
	oG = oGP.queryGraphic(aArgs)
	aSize = oG.SizePixel
	'msgbox oG.DBG_Properties
	'aSize = oG.Size100thMM
	'msgbox aSize.Width		←何故か 0

	'図オブジェクトの作成
	dim oDoc		as object
	dim oShape		as object

	oDoc = StarDesktop.CurrentComponent	'このコードを実行しているドキュメントを返す
	oShape = oDoc.createInstance("com.sun.star.drawing.GraphicObjectShape")

	'図形オブジェクトのサイズと位置を調整
	dim aPoint		as new com.sun.star.awt.Point
	dim margin		as long
	dim w			as double
	dim h			as double
	dim pw			as double
	dim ph			as double

	margin = 30
	w = oRange.Size.Width - 2 * margin
	h = oRange.Size.Height - 2 * margin
	pw = w / aSize.Width
	ph = h / aSize.Height
	if pw < ph then
		aSize.Width = w
		aSize.Height = pw * aSize.Height
	else
		aSize.Width = ph * aSize.Width
		aSize.Height = h
	endif
	aPoint.X = oRange.Position.X +  (oRange.Size.Width - aSize.Width) / 2
	aPoint.Y = oRange.Position.Y + (oRange.Size.Height - aSize.Height) / 2
	oShape.setPosition(aPoint)
	oShape.setSize(aSize)
	oShape.Graphic = oG

	'ページに埋め込む
	dim oSheet	as object
	dim oPage	as object
	oSheet = oDoc.CurrentController.ActiveSheet
	oPage = oSheet.DrawPage
	oPage.add(oShape)
end sub

かじゅ OpenOffice.org OpenOffice.org, calc