OOobbs3/90

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

感想，コメント，メモ

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

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

OOobbs3/90

Menu

Search

recent(15)

OOobbs3/90

質問

回答

感想，コメント，メモ