Top > OOobbs3 > 90

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

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

 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 を指定しなければそのプロパティは削除できなくなるようですが、その後どうなるかよくわかりませんので注意。

-- はにゃ? &new{2012-04-09 (月) 15:00:42};
- ありがとうございました。解決しました。hasByNameは、hasPropertyByNameでした。 -- いしみず &new{2012-04-09 (月) 19:21:37};
- 関連でもうひとつ質問ですが、ThisComponentではなく別の開いていないドキュメントの場合はどうすればよいでしょうか?よろしくお願いします。 -- いしみず &new{2012-04-09 (月) 19:23:04};
- > hasPropertyByName 直しておきました。 -- はにゃ? &new{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


-- はにゃ? &new{2012-04-09 (月) 21:27:45};
- お返事遅くなりました。ありがとうございました。ですがプロパティのgetはできるのですが、setができません。 -- いしみず &new{2012-04-11 (水) 13:09:06};
- 私の環境では問題なく動作するようです。 -- はにゃ? &new{2012-04-11 (水) 21:11:40};
- URLをコンバートしないとだめでした。開いている他のドキュメントはうまくいきました。ありがとうございました。 -- いしみず &new{2012-04-12 (木) 12:06:04};

#comment
*** 感想,コメント,メモ [#pf1a21ad]
#comment
コードを書きました。よろしくお願いします。

 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