OpenOffice Calcで画像の貼り付けを連続的に行うマクロ

最近、MSofficeがインストールされていない制御用のWindowsXP搭載のPCに遭遇

USB起動で画面プリントが連続的に取れるAPをと探していたらOpenOffice portable へ巡り合った

そしてこれのマクロを色々なサイトの情報を頼りに書いてみた

ExcelインストールされていないPCで画面キャプチャを取る時に結構使えそうなのでここに掲載する

使い方

・Sheet1を作成する

・Sheet1へ適当なボタン用に画像を作成

・この画像に以下のコードのマクロを登録する

・その画像ボタンを押すたび

・Sheet1の左端にnewsheet2、newsheet3・・・newsheetNが追加

・追加されたnewsheetNへクリップボードからの画像が貼られ

・サイズが75%に縮小され…0.75を書き換えれば任意

・最後にSheet1へ戻る

REM  *****  20110524 kujiranodanna wrote  *****
sub Main
  dim oDocument As Object
  dim oSheet As Object
  dim sName As String
  dim document   as object
  dim dispatcher as object
  dim args1(1) as new com.sun.star.beans.PropertyValue
  document = ThisComponent.CurrentController.Frame
  dispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
  oDocument = ThisComponent
  sName = "newsheet" & oDocument.Sheets.getCount()+1
  args1(0).Name = "Name"
  args1(0).Value = sName
  args1(1).Name = "Index"
  args1(1).Value = 1
  dispatcher.executeDispatch(document, ".uno:Insert", "", 0, args1())
  oSheet = ThisComponent.Sheets.getByName(sName)
  oCell = oSheet.getCellRangeByName("A1")
  ThisComponent.CurrentController.ActiveSheet
  dispatcher.executeDispatch(document, ".uno:Paste", "", 0, Array())
    
rem ***** resize *****
  dim Sheet as Object
  dim pSheet as Object
  dim picture as Object
  dim pictureResize as new com.sun.star.awt.Size
  Sheet = ThisComponent.CurrentController.ActiveSheet
  pSheet = Sheet.getDrawPage
  picture = pSheet.getByIndex( pSheet.getCount - 1 )
  with pictureResize
    .Width =  picture.Size.Width * 0.75
    .Height =  picture.Size.Height * 0.75
  end with
  picture.setSize(pictureResize)
    
rem ***** return to sheet1 *****
  ThisComponent.CurrentController.ActiveSheet = ThisComponent.Sheets.getByName("Sheet1")
  args1(0).Name = "ToPoint"
  args1(0).Value = "$A$1"
  dispatcher.executeDispatch(document, ".uno:GoToCell", "", 0, args1())

end sub