OOobbs3/90
質問
いつもお世話になってます。OpenOffice3.3のカルクを利用しています。ファイルのプロパティにあるカスタムプロパティをマクロ(BASIC)で追加したり、削除したりしたいのですが、どのようにすればよいでしょうか?以上 よろしくお願いします。 回答
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 を指定しなければそのプロパティは削除できなくなるようですが、その後どうなるかよくわかりませんので注意。
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
感想,コメント,メモ
コードを書きました。よろしくお願いします。 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 |