Top > OOobbs3 > 90

OOobbs3/90 Edit

  • サマリ: ドキュメントのカスタムプロパティを追加・削除したい
  • 環境: General
  • 状態: 解決
  • 投稿者: いしみず?
  • 投稿日: 2012-04-09 (月) 13:11:44

質問 Edit

いつもお世話になってます。OpenOffice3.3のカルクを利用しています。ファイルのプロパティにあるカスタムプロパティをマクロ(BASIC)で追加したり、削除したりしたいのですが、どのようにすればよいでしょうか?以上 よろしくお願いします。

回答 Edit

  • 次のような感じになります。
Sub SetDocumentProperty
 doc = ThisComponent
 p = doc.getDocumentProperties()
 props = p.getUserDefinedProperties()
 
 ' プロパティを追加
 ' REMOVEABLE を指定しなければ削除できなくなる
 attr = com.sun.star.beans.PropertyAttribute.REMOVEABLE
 ' プロパティ名、フィールド属性、デフォルト値
 props.addProperty("New2", attr, "")
 
 ' プロパティに値を設定
 props.setPropertyValue("New2", "foo")
 
 ' プロパティを削除
 'props.removeProperty("New2")
End Sub

プロパティがすでにあるかどうかを調べるには次のようにします。

props.getPropertySetInfo().hasPropertyByName("name")

プロパティ追加時に REMOVEABLE を指定しなければそのプロパティは削除できなくなるようですが、その後どうなるかよくわかりませんので注意。

  • はにゃ? 2012-04-09 (月) 15:00:42
  • ありがとうございました。解決しました。hasByNameは、hasPropertyByNameでした。 -- いしみず 2012-04-09 (月) 19:21:37
  • 関連でもうひとつ質問ですが、ThisComponentではなく別の開いていないドキュメントの場合はどうすればよいでしょうか?よろしくお願いします。 -- いしみず 2012-04-09 (月) 19:23:04
  • > hasPropertyByName 直しておきました。 -- はにゃ? 2012-04-09 (月) 21:27:12
  • 新規ドキュメントでなければ、デスクトップオブジェクトから該当するドキュメントオブジェクトを見つける必要があります。
components = StarDesktop.getComponents()
enume = components.createEnumeration()
 Do while enume.hasMoreElements()
  comp = enume.nextElement()
  ' この場合、css.lang.XComponent インターフェースをエクスポートしているオブジェクトは
  ' css.frame.XModel インタフェースをエクスポートしているドキュメントオブジェクト
  '...
  If comp.getURL() = "nantokakantoka" then
    exit do
  End If
Loop
  • はにゃ? 2012-04-09 (月) 21:27:45
  • お返事遅くなりました。ありがとうございました。ですがプロパティのgetはできるのですが、setができません。 -- いしみず 2012-04-11 (水) 13:09:06
  • 私の環境では問題なく動作するようです。 -- はにゃ? 2012-04-11 (水) 21:11:40
  • URLをコンバートしないとだめでした。開いている他のドキュメントはうまくいきました。ありがとうございました。 -- いしみず 2012-04-12 (木) 12:06:04

感想,コメント,メモ Edit


コードを書きました。よろしくお願いします。

Option Explicit

Private Sub TestBtn_Push()
  Dim sURL As String 

  sURL = "D:\OooBasic\テスト\testX71.ods"
  'Call getCustomProperty(sURL)
  Call setCustomProperty(sURL)
End Sub
Sub getCustomProperty(sURL As String)
  Dim oDoc As Object
  Dim oDocInfo As Object
  Dim oProps As Object
  Dim oProp As Object
	
  oDoc = getDocObject(sURL)
  oDocInfo = oDoc.getDocumentProperties()
  oProps = oDocInfo.getUserDefinedProperties()
	
  If oProps.getPropertySetInfo().hasPropertyByName("test") = True Then
    oProp = oProps.getPropertySetInfo().getPropertyByName("test")
    msgbox oProps.getPropertyValue("test")
  End If
End Sub
Sub setCustomProperty(sURL As String)
  ' カスタムプロパティのセット
  Dim oDoc As Object
  Dim oDocInfo As Object
  Dim oProps As Object
  Dim attr as Variant

  'oDoc = ThisComponent
  'oDocInfo = oDoc.getDocumentProperties()
  oDoc = getDocObject(sURL)
  oDocInfo = oDoc.getDocumentProperties()
  oProps = oDocInfo.getUserDefinedProperties()

  ' プロパティを追加
  ' REMOVEABLE を指定しなければ削除できなくなる
  attr = com.sun.star.beans.PropertyAttribute.REMOVEABLE
  ' プロパティ名、フィールド属性、デフォルト値
  If oProps.getPropertySetInfo().hasPropertyByName("test") = False Then
    oProps.addProperty("test", attr, "")
  End If
  ' プロパティに値を設定
  oProps.setPropertyValue("test", "aaaa")
 
  ' プロパティを削除
  'oProps.removeProperty("New2")
End Sub
Function getDocObject(sURL As String) As Object
  Dim oComponents As Object
  Dim oEnume As Object
  Dim oComp As Object
	
  oComponents = StarDesktop.getComponents()
  oEnume = oComponents.createEnumeration()
  Do while oEnume.hasMoreElements()
	oComp = oEnume.nextElement()
	' この場合、css.lang.XComponent インターフェースをエクスポートしているオブジェクトは
	' css.frame.XModel インタフェースをエクスポートしているドキュメントオブジェクト
	'...
	If oComp.getURL() = ConvetToUrl(sURL) Then
      Exit Do
 	End If
  Loop

  getDocObject = oComp
End Function

Reload   New Lower page making Edit Freeze Diff Upload Copy Rename   Front page List of pages Search Recent changes Backup   Help   RSS of recent changes