REM ======================================================================================================================= REM === The ScriptForge library and its associated libraries are part of the LibreOffice project. === REM === The SFDocuments library is one of the associated libraries. === REM === Full documentation is available on https://help.libreoffice.org/ === REM ======================================================================================================================= Option Compatible Option ClassModule Option Explicit ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' ''' SF_Document ''' =========== ''' ''' The SFDocuments library gathers a number of methods and properties making easy ''' managing and manipulating LibreOffice documents ''' ''' Some methods are generic for all types of documents: they are combined in the ''' current SF_Document module ''' - saving, closing documents ''' - accessing their standard or custom properties ''' Specific properties and methods are implemented in the concerned subclass(es) SF_Calc, SF_Base, ... ''' ''' Documents might contain forms. The current service gives access to the "SFDocuments.Form" service ''' ''' To workaround the absence of class inheritance in LibreOffice Basic, some redundancy is necessary ''' Each subclass MUST implement also the generic methods and properties, even if they only call ''' the parent methods and properties implemented below ''' They should also duplicate some generic private members as a subset of their own set of members ''' ''' The current module is closely related to the "UI" and "FileSystem" services ''' of the ScriptForge library ''' ''' Service invocation examples: ''' 1) From the UI service ''' Dim ui As Object, oDoc As Object ''' Set ui = CreateScriptService("UI") ''' Set oDoc = ui.GetDocument("Untitled 1") ''' ' or Set oDoc = ui.CreateDocument("Calc", ...) ''' ' or Set oDoc = ui.OpenDocument("C:\Me\MyFile.odt") ''' 2) Directly if the document is already opened ''' Dim oDoc As Object ''' Set oDoc = CreateScriptService("SFDocuments.Document", "Untitled 1") ' Default = ActiveWindow ''' ' The substring "SFDocuments." in the service name is optional ''' ''' Detailed user documentation: ''' https://help.libreoffice.org/latest/en-US/text/sbasic/shared/03/sf_document.html?DbPAR=BASIC ''' ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' REM ================================================================== EXCEPTIONS Private Const DOCUMENTDEADERROR = "DOCUMENTDEADERROR" Private Const DOCUMENTSAVEERROR = "DOCUMENTSAVEERROR" Private Const DOCUMENTSAVEASERROR = "DOCUMENTSAVEASERROR" Private Const DOCUMENTREADONLYERROR = "DOCUMENTREADONLYERROR" Private Const FORMDEADERROR = "FORMDEADERROR" REM ============================================================= PRIVATE MEMBERS Private [Me] As Object Private [_Parent] As Object Private [_SubClass] As Object ' Subclass instance Private ObjectType As String ' Must be DOCUMENT Private ServiceName As String ' Window description Private _Component As Object ' com.sun.star.lang.XComponent Private _Frame As Object ' com.sun.star.comp.framework.Frame Private _WindowName As String ' Object Name Private _WindowTitle As String ' Only mean to identify new documents Private _WindowFileName As String ' URL of file name Private _DocumentType As String ' Writer, Calc, ... ' Properties (work variables - real properties could have been set manually by user) Private _DocumentProperties As Object ' Dictionary of document properties Private _CustomProperties As Object ' Dictionary of custom properties REM ============================================================ MODULE CONSTANTS Const ISDOCFORM = 1 ' Form is stored in a Writer document REM ====================================================== CONSTRUCTOR/DESTRUCTOR REM ----------------------------------------------------------------------------- Private Sub Class_Initialize() Set [Me] = Nothing Set [_Parent] = Nothing Set [_SubClass] = Nothing ObjectType = "DOCUMENT" ServiceName = "SFDocuments.Document" Set _Component = Nothing Set _Frame = Nothing _WindowName = "" _WindowTitle = "" _WindowFileName = "" _DocumentType = "" Set _DocumentProperties = Nothing Set _CustomProperties = Nothing End Sub ' SFDocuments.SF_Document Constructor REM ----------------------------------------------------------------------------- Private Sub Class_Terminate() Call Class_Initialize() End Sub ' SFDocuments.SF_Document Destructor REM ----------------------------------------------------------------------------- Public Function Dispose() As Variant Call Class_Terminate() Set Dispose = Nothing End Function ' SFDocuments.SF_Document Explicit Destructor REM ================================================================== PROPERTIES REM ----------------------------------------------------------------------------- Property Get CustomProperties() As Variant ''' Returns a dictionary of all custom properties of the document CustomProperties = _PropertyGet("CustomProperties") End Property ' SFDocuments.SF_Document.CustomProperties REM ----------------------------------------------------------------------------- Property Let CustomProperties(Optional ByVal pvCustomProperties As Variant) ''' Sets the updatable custom properties ''' The argument is a dictionary Dim vPropertyValues As Variant ' Array of com.sun.star.beans.PropertyValue Dim vCustomProperties As Variant ' Alias of argument Dim oUserdefinedProperties As Object ' Custom properties object Dim vOldPropertyValues As Variant ' Array of (to remove) existing user defined properties Dim oProperty As Object ' Single com.sun.star.beans.PropertyValues Dim sProperty As String ' Property name Dim vKeys As Variant ' Array of dictionary keys Dim vItems As Variant ' Array of dictionary items Dim vValue As Variant ' Value to store in property Dim iAttribute As Integer ' com.sun.star.beans.PropertyAttribute.REMOVEABLE Dim i As Long Const cstThisSub = "SFDocuments.Document.setCustomProperties" Const cstSubArgs = "CustomProperties" On Local Error GoTo Catch Check: If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then If Not _IsStillAlive(True) Then GoTo Finally If Not ScriptForge.SF_Utils._Validate(pvCustomProperties, "CustomProperties", ScriptForge.V_OBJECT, , , "DICTIONARY") Then GoTo Finally End If Try: Set oUserDefinedProperties = _Component.getDocumentProperties().UserDefinedProperties Set vCustomProperties = pvCustomProperties ' To avoid "Object variable not set" error With vCustomProperties ' All existing custom properties must first be removed to avoid type conflicts vOldPropertyValues = oUserDefinedProperties.getPropertyValues For Each oProperty In vOldPropertyValues sProperty = oProperty.Name oUserDefinedProperties.removeProperty(sProperty) Next oProperty ' Insert new properties one by one after type adjustment (dates, arrays, numbers) vKeys = .Keys vItems = .Items iAttribute = com.sun.star.beans.PropertyAttribute.REMOVEABLE For i = 0 To UBound(vKeys) If VarType(vItems(i)) = V_DATE Then vValue = ScriptForge.SF_Utils._CDateToUnoDate(vItems(i)) ElseIf IsArray(vItems(i)) Then vValue = Null ElseIf ScriptForge.SF_Utils._VarTypeExt(vItems(i)) = ScriptForge.V_NUMERIC Then vValue = CreateUnoValue("double", vItems(i)) Else vValue = vItems(i) End If oUserDefinedProperties.addProperty(vKeys(i), iAttribute, vValue) Next i ' Declare the document as changed _Component.setModified(True) End With ' Reload custom properties in current object instance _PropertyGet("CustomProperties") Finally: ScriptForge.SF_Utils._ExitFunction(cstThisSub) Exit Property Catch: GoTo Finally End Property ' SFDocuments.SF_Document.CustomProperties REM ----------------------------------------------------------------------------- Property Get Description() As Variant ''' Returns the updatable document property Description Description = _PropertyGet("Description") End Property ' SFDocuments.SF_Document.Description REM ----------------------------------------------------------------------------- Property Let Description(Optional ByVal pvDescription As Variant) ''' Sets the updatable document property Description ''' If multilined, separate lines by "\n" escape sequence or by hard breaks Dim sDescription As String ' Alias of pvDescription Const cstThisSub = "SFDocuments.Document.setDescription" Const cstSubArgs = "Description" Check: If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then If Not _IsStillAlive(True) Then GoTo Finally If Not ScriptForge.SF_Utils._Validate(pvDescription, "Description", V_STRING) Then GoTo Finally End If Try: ' Update in UNO component object and in current instance sDescription = Replace(pvDescription, "\n", ScriptForge.SF_String.sfNEWLINE) _Component.DocumentProperties.Description = sDescription If Not IsNull(_DocumentProperties) Then _DocumentProperties.ReplaceItem("Description", sdescription) Finally: ScriptForge.SF_Utils._ExitFunction(cstThisSub) Exit Property End Property ' SFDocuments.SF_Document.Description REM ----------------------------------------------------------------------------- Property Get DocumentProperties() As Variant ''' Returns a dictionary of all standard document properties, custom properties are excluded DocumentProperties = _PropertyGet("DocumentProperties") End Property ' SFDocuments.SF_Document.DocumentProperties REM ----------------------------------------------------------------------------- Property Get DocumentType() As String ''' Returns "Base", "Calc", "Draw", ... or "Writer" DocumentType = _PropertyGet("DocumentType") End Property ' SFDocuments.SF_Document.DocumentType REM ----------------------------------------------------------------------------- Property Get IsBase() As Boolean IsBase = _PropertyGet("IsBase") End Property ' SFDocuments.SF_Document.IsBase REM ----------------------------------------------------------------------------- Property Get IsCalc() As Boolean IsCalc = _PropertyGet("IsCalc") End Property ' SFDocuments.SF_Document.IsCalc REM ----------------------------------------------------------------------------- Property Get IsDraw() As Boolean IsDraw = _PropertyGet("IsDraw") End Property ' SFDocuments.SF_Document.IsDraw REM ----------------------------------------------------------------------------- Property Get IsImpress() As Boolean IsImpress = _PropertyGet("IsImpress") End Property ' SFDocuments.SF_Document.IsImpress REM ----------------------------------------------------------------------------- Property Get IsMath() As Boolean IsMath = _PropertyGet("IsMath") End Property ' SFDocuments.SF_Document.IsMath REM ----------------------------------------------------------------------------- Property Get IsWriter() As Boolean IsWriter = _PropertyGet("IsWriter") End Property ' SFDocuments.SF_Document.IsWriter REM ----------------------------------------------------------------------------- Property Get Keywords() As Variant ''' Returns the updatable document property Keywords Keywords = _PropertyGet("Keywords") End Property ' SFDocuments.SF_Document.Keywords REM ----------------------------------------------------------------------------- Property Let Keywords(Optional ByVal pvKeywords As Variant) ''' Sets the updatable document property Keywords Dim vKeywords As Variant ' Alias of pvKeywords Const cstThisSub = "SFDocuments.Document.setKeywords" Const cstSubArgs = "Keywords" Check: If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then If Not _IsStillAlive(True) Then GoTo Finally If Not ScriptForge.SF_Utils._Validate(pvKeywords, "Keywords", V_STRING) Then GoTo Finally End If Try: ' Update in UNO component object and in current instance vKeywords = ScriptForge.SF_Array.TrimArray(Split(pvKeywords, ",")) _Component.DocumentProperties.Keywords = vKeywords If Not IsNull(_DocumentProperties) Then _DocumentProperties.ReplaceItem("Keywords", Join(vKeywords, ", ")) Finally: ScriptForge.SF_Utils._ExitFunction(cstThisSub) Exit Property End Property ' SFDocuments.SF_Document.Keywords REM ----------------------------------------------------------------------------- Property Get Readonly() As Boolean ''' Returns True if the document must not be modified Readonly = _PropertyGet("Readonly") End Property ' SFDocuments.SF_Document.Readonly REM ----------------------------------------------------------------------------- Property Get Subject() As Variant ''' Returns the updatable document property Subject Subject = _PropertyGet("Subject") End Property ' SFDocuments.SF_Document.Subject REM ----------------------------------------------------------------------------- Property Let Subject(Optional ByVal pvSubject As Variant) ''' Sets the updatable document property Subject Const cstThisSub = "SFDocuments.Document.setSubject" Const cstSubArgs = "Subject" Check: If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then If Not _IsStillAlive(True) Then GoTo Finally If Not ScriptForge.SF_Utils._Validate(pvSubject, "Subject", V_STRING) Then GoTo Finally End If Try: ' Update in UNO component object and in current instance _Component.DocumentProperties.Subject = pvSubject If Not IsNull(_DocumentProperties) Then _DocumentProperties.ReplaceItem("Subject", pvSubject) Finally: ScriptForge.SF_Utils._ExitFunction(cstThisSub) Exit Property End Property ' SFDocuments.SF_Document.Subject REM ----------------------------------------------------------------------------- Property Get Title() As Variant ''' Returns the updatable document property Title Title = _PropertyGet("Title") End Property ' SFDocuments.SF_Document.Title REM ----------------------------------------------------------------------------- Property Let Title(Optional ByVal pvTitle As Variant) ''' Sets the updatable document property Title Const cstThisSub = "SFDocuments.Document.setTitle" Const cstSubArgs = "Title" Check: If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then If Not _IsStillAlive(True) Then GoTo Finally If Not ScriptForge.SF_Utils._Validate(pvTitle, "Title", V_STRING) Then GoTo Finally End If Try: ' Update in UNO component object and in current instance _Component.DocumentProperties.Title = pvTitle If Not IsNull(_DocumentProperties) Then _DocumentProperties.ReplaceItem("Title", pvTitle) Finally: ScriptForge.SF_Utils._ExitFunction(cstThisSub) Exit Property End Property ' SFDocuments.SF_Document.Title REM ----------------------------------------------------------------------------- Property Get XComponent() As Variant ''' Returns the com.sun.star.lang.XComponent UNO object representing the document XComponent = _PropertyGet("XComponent") End Property ' SFDocuments.SF_Document.XComponent REM ===================================================================== METHODS REM ----------------------------------------------------------------------------- Public Function Activate() As Boolean ''' Make the current document active ''' Args: ''' Returns: ''' True if the document could be activated ''' Otherwise, there is no change in the actual user interface ''' Examples: ''' oDoc.Activate() Dim bActivate As Boolean ' Return value Dim oContainer As Object ' com.sun.star.awt.XWindow Const cstThisSub = "SFDocuments.Document.Activate" Const cstSubArgs = "" If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch bActivate = False Check: ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) If Not _IsStillAlive() Then GoTo Finally Try: Set oContainer = _Frame.ContainerWindow With oContainer If .isVisible() = False Then .setVisible(True) .IsMinimized = False .setFocus() .toFront() ' Force window change in Linux Wait 1 ' Bypass desynchro issue in Linux End With bActivate = True Finally: Activate = bActivate ScriptForge.SF_Utils._ExitFunction(cstThisSub) Exit Function Catch: GoTo Finally End Function ' SFDocuments.SF_Document.Activate REM ----------------------------------------------------------------------------- Public Function CloseDocument(Optional ByVal SaveAsk As Variant) As Boolean ''' Close the document. Does nothing if the document is already closed ''' regardless of how the document was closed, manually or by program ''' Args: ''' SaveAsk: If True (default), the user is invited to confirm or not the writing of the changes on disk ''' No effect if the document was not modified ''' Returns: ''' False if the user declined to close ''' Examples: ''' If oDoc.CloseDocument() Then ''' ' ... Dim bClosed As Boolean ' return value Dim oDispatch ' com.sun.star.frame.DispatchHelper Const cstThisSub = "SFDocuments.Document.CloseDocument" Const cstSubArgs = "[SaveAsk=True]" If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch bClosed = False Check: If IsMissing(SaveAsk) Or IsEmpty(SaveAsk) Then SaveAsk = True If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then If Not _IsStillAlive() Then GoTo Finally If Not ScriptForge.SF_Utils._Validate(SaveAsk, "SaveAsk", ScriptForge.V_BOOLEAN) Then GoTo Finally End If Try: If SaveAsk And _Component.IsModified Then ' Execute closure with the File/Close menu command Activate() RunCommand("CloseDoc") bClosed = _IsStillAlive(, False) ' Do not raise error Else _Frame.close(True) _Frame.dispose() bClosed = True End If Finally: If bClosed Then Dispose() CloseDocument = bClosed ScriptForge.SF_Utils._ExitFunction(cstThisSub) Exit Function Catch: GoTo Finally End Function ' SFDocuments.SF_Document.CloseDocument REM ----------------------------------------------------------------------------- Public Function CreateMenu(Optional ByVal MenuHeader As Variant _ , Optional ByVal Before As Variant _ , Optional ByVal SubmenuChar As Variant _ , Optional ByRef _Document As Variant _ ) As Object ''' Create a new menu entry in the document's menubar ''' The menu is not intended to be saved neither in the LibreOffice global environment, nor in the document ''' The method returns a SFWidgets.Menu instance. Its methods let define the menu further. ''' Args: ''' MenuHeader: the name/header of the menu ''' Before: the place where to put the new menu on the menubar (string or number >= 1) ''' When not found => last position ''' SubmenuChar: the delimiter used in menu trees. Default = ">" ''' _Document: undocumented argument to designate the document where the menu will be located ''' Returns: ''' A SFWidgets.Menu instance or Nothing ''' Examples: ''' Dim oMenu As Object ''' Set oMenu = oDoc.CreateMenu("My menu", Before := "Styles") ''' With oMenu ''' .AddItem("Item 1", Command := "About") ''' '... ''' .Dispose() ' When definition is complete, the menu instance may be disposed ''' End With ''' ' ... Dim oMenu As Object ' return value Const cstThisSub = "SFDocuments.Document.CreateMenu" Const cstSubArgs = "MenuHeader, [Before=""""], [SubmenuChar="">""]" If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch Set oMenu = Nothing Check: If IsMissing(Before) Or IsEmpty(Before) Then Before = "" If IsMissing(SubmenuChar) Or IsEmpty(SubmenuChar) Then SubmenuChar = "" If IsMissing(_Document) Or IsEmpty(_Document) Or IsNull(_Document) Then Set _Document = _Component If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then If Not _IsStillAlive() Then GoTo Finally If Not ScriptForge.SF_Utils._Validate(MenuHeader, "MenuHeader", V_STRING) Then GoTo Finally If Not ScriptForge.SF_Utils._Validate(Before, "Before", V_STRING) Then GoTo Finally If Not ScriptForge.SF_Utils._Validate(SubmenuChar, "SubmenuChar", V_STRING) Then GoTo Finally End If Try: Set oMenu = ScriptForge.SF_Services.CreateScriptService("SFWidgets.Menu", _Document, MenuHeader, Before, SubmenuChar) Finally: Set CreateMenu = oMenu ScriptForge.SF_Utils._ExitFunction(cstThisSub) Exit Function Catch: GoTo Finally End Function ' SFDocuments.SF_Document.CreateMenu REM ----------------------------------------------------------------------------- Public Function ExportAsPDF(Optional ByVal FileName As Variant _ , Optional ByVal Overwrite As Variant _ , Optional ByVal Pages As Variant _ , Optional ByVal Password As Variant _ , Optional ByVal Watermark As Variant _ ) As Boolean ''' Store the document to the given file location in PDF format ''' Args: ''' FileName: Identifies the file where to save. It must follow the SF_FileSystem.FileNaming notation ''' Overwrite: True if the destination file may be overwritten (default = False) ''' Pages: the pages to print as a string, like in the user interface. Example: "1-4;10;15-18". Default = all pages ''' Password: password to open the document ''' Watermark: the text for a watermark to be drawn on every page of the exported PDF file ''' Returns: ''' False if the document could not be saved ''' Exceptions: ''' DOCUMENTSAVEASERROR The destination has its readonly attribute set or overwriting rejected ''' Examples: ''' oDoc.ExportAsPDF("C:\Me\myDoc.pdf", Overwrite := True) Dim bSaved As Boolean ' return value Dim oSfa As Object ' com.sun.star.ucb.SimpleFileAccess Dim sFile As String ' Alias of FileName Dim sFilter As String ' One of the pdf filter names Dim vFilterData As Variant ' Array of com.sun.star.beans.PropertyValue Dim vProperties As Variant ' Array of com.sun.star.beans.PropertyValue Dim FSO As Object ' SF_FileSystem Const cstThisSub = "SFDocuments.Document.ExportAsPDF" Const cstSubArgs = "FileName, [Overwrite=False], [Pages=""""], [Password=""""], [Watermark=""""]" If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo CatchError bSaved = False Check: If IsMissing(Overwrite) Or IsEmpty(Overwrite) Then Overwrite = False If IsMissing(Pages) Or IsEmpty(Pages) Then Pages = "" If IsMissing(Password) Or IsEmpty(Password) Then Password = "" If IsMissing(Watermark) Or IsEmpty(Watermark) Then Watermark = "" If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then If Not _IsStillAlive() Then GoTo Finally If Not SF_Utils._ValidateFile(FileName, "FileName") Then GoTo Finally If Not SF_Utils._Validate(Overwrite, "Overwrite", ScriptForge.V_BOOLEAN) Then GoTo Finally If Not SF_Utils._Validate(Pages, "Pages", V_STRING) Then GoTo Finally If Not SF_Utils._Validate(Password, "Password", V_STRING) Then GoTo Finally If Not SF_Utils._Validate(Watermark, "Watermark", V_STRING) Then GoTo Finally End If ' Check destination file overwriting Set FSO = CreateScriptService("FileSystem") sFile = FSO._ConvertToUrl(FileName) If FSO.FileExists(FileName) Then If Overwrite = False Then GoTo CatchError Set oSfa = ScriptForge.SF_Utils._GetUNOService("FileAccess") If oSfa.isReadonly(sFile) Then GoTo CatchError End If Try: ' Setup arguments sFilter = LCase(_DocumentType) & "_pdf_Export" ' FilterData parameters are added only if they are meaningful vFilterData = Array() If Len(Pages) > 0 Then vFilterData = ScriptForge.SF_Array.Append(vFilterData _ , ScriptForge.SF_Utils._MakePropertyValue("PageRange", Pages)) End If If Len(Password) > 0 Then vFilterData = ScriptForge.SF_Array.Append(vFilterData _ , ScriptForge.SF_Utils._MakePropertyValue("EncryptFile", True) _ , ScriptForge.SF_Utils._MakePropertyValue("DocumentOpenPassword", Password)) End If If Len(Watermark) > 0 Then vFilterData = ScriptForge.SF_Array.Append(vFilterData _ , ScriptForge.SF_Utils._MakePropertyValue("Watermark", Watermark)) End If ' Finalize properties and export vProperties = Array( _ ScriptForge.SF_Utils._MakePropertyValue("FilterName", sFilter) _ , ScriptForge.SF_Utils._MakePropertyValue("FilterData", vFilterData)) _Component.StoreToURL(sFile, vProperties) bSaved = True Finally: ExportAsPDF = bSaved ScriptForge.SF_Utils._ExitFunction(cstThisSub) Exit Function Catch: GoTo Finally CatchError: ScriptForge.SF_Exception.RaiseFatal(DOCUMENTSAVEASERROR, "FileName", FileName, "Overwrite", Overwrite _ , "FilterName", "PDF Export") GoTo Finally End Function ' SFDocuments.SF_Document.ExportAsPDF REM ----------------------------------------------------------------------------- Public Function GetProperty(Optional ByVal PropertyName As Variant) As Variant ''' Return the actual value of the given property ''' Args: ''' PropertyName: the name of the property as a string ''' Returns: ''' The actual value of the property ''' If the property does not exist, returns Null ''' Exceptions: ''' see the exceptions of the individual properties ''' Examples: ''' myModel.GetProperty("MyProperty") Const cstThisSub = "SFDocuments.Document.GetProperty" Const cstSubArgs = "" If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch GetProperty = Null Check: If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then If Not ScriptForge.SF_Utils._Validate(PropertyName, "PropertyName", V_STRING, Properties()) Then GoTo Catch End If Try: GetProperty = _PropertyGet(PropertyName) Finally: ScriptForge.SF_Utils._ExitFunction(cstThisSub) Exit Function Catch: GoTo Finally End Function ' SFDocuments.SF_Document.GetProperty REM ----------------------------------------------------------------------------- Public Function Methods() As Variant ''' Return the list of public methods of the Document service as an array Methods = Array( _ "Activate" _ , "CloseDocument" _ , "CreateMenu" _ , "ExportAsPDF" _ , "PrintOut" _ , "RemoveMenu" _ , "RunCommand" _ , "Save" _ , "SaveAs" _ , "SaveCopyAs" _ , "SetPrinter" _ ) End Function ' SFDocuments.SF_Document.Methods REM ----------------------------------------------------------------------------- Public Function PrintOut(Optional ByVal Pages As Variant _ , Optional ByVal Copies As Variant _ , Optional ByRef _Document As Variant _ ) As Boolean ''' Send the content of the document to the printer. ''' The printer might be defined previously by default, by the user or by the SetPrinter() method ''' Args: ''' Pages: the pages to print as a string, like in the user interface. Example: "1-4;10;15-18". Default = all pages ''' Copies: the number of copies ''' _Document: undocumented argument to designate the document to print when called from a subclass ''' Returns: ''' True when successful ''' Examples: ''' oDoc.PrintOut("1-4;10;15-18", Copies := 2) Dim bPrint As Boolean ' Return value Dim vPrintGoal As Variant ' Array of property values Const cstThisSub = "SFDocuments.Document.PrintOut" Const cstSubArgs = "[Pages=""""], [Copies=1]" If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch bPrint = False Check: If IsMissing(Pages) Or IsEmpty(Pages) Then Pages = "" If IsMissing(Copies) Or IsEmpty(Copies) Then Copies = 1 If IsMissing(_Document) Or IsEmpty(_Document) Or IsNull(_Document) Then Set _Document = _Component If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then If Not _IsStillAlive() Then GoTo Finally If Not ScriptForge.SF_Utils._Validate(Pages, "Pages", V_STRING) Then GoTo Finally If Not ScriptForge.SF_Utils._Validate(Copies, "Copies", ScriptForge.V_NUMERIC) Then GoTo Finally End If Try: vPrintGoal = Array( _ ScriptForge.SF_Utils._MakePropertyValue("CopyCount", CInt(Copies)) _ , ScriptForge.SF_Utils._MakePropertyValue("Collate", True) _ , ScriptForge.SF_Utils._MakePropertyValue("Pages", Pages) _ , ScriptForge.SF_Utils._MakePropertyValue("Wait", False) _ ) _Document.Print(vPrintGoal) bPrint = True Finally: PrintOut = bPrint ScriptForge.SF_Utils._ExitFunction(cstThisSub) Exit Function Catch: GoTo Finally End Function ' SFDocuments.SF_Document.PrintOut REM ----------------------------------------------------------------------------- Public Function Properties() As Variant ''' Return the list or properties of the Document class as an array Properties = Array( _ "CustomProperties" _ , "Description" _ , "DocumentProperties" _ , "DocumentType" _ , "IsBase" _ , "IsCalc" _ , "IsDraw" _ , "IsImpress" _ , "IsMath" _ , "IsWriter" _ , "Keywords" _ , "Readonly" _ , "Subject" _ , "Title" _ , "XComponent" _ ) End Function ' SFDocuments.SF_Document.Properties REM ----------------------------------------------------------------------------- Public Function RemoveMenu(Optional ByVal MenuHeader As Variant _ , Optional ByRef _Document As Variant _ ) As Boolean ''' Remove a menu entry in the document's menubar ''' The removal is not intended to be saved neither in the LibreOffice global environment, nor in the document ''' Args: ''' MenuHeader: the name/header of the menu, without tilde "~", as a case-sensitive string ''' _Document: undocumented argument to designate the document where the menu is located ''' Returns: ''' True when successful ''' Examples: ''' oDoc.RemoveMenu("File") ''' ' ... Dim bRemove As Boolean ' Return value Dim oLayout As Object ' com.sun.star.comp.framework.LayoutManager Dim oMenuBar As Object ' com.sun.star.awt.XMenuBar or stardiv.Toolkit.VCLXMenuBar Dim sName As String ' Menu name Dim iMenuId As Integer ' Menu identifier Dim iMenuPosition As Integer ' Menu position >= 0 Dim i As Integer Const cstTilde = "~" Const cstThisSub = "SFDocuments.Document.RemoveMenu" Const cstSubArgs = "MenuHeader" If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch bRemove = False Check: If IsMissing(_Document) Or IsEmpty(_Document) Or IsNull(_Document) Then Set _Document = _Component If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then If Not _IsStillAlive() Then GoTo Finally If Not ScriptForge.SF_Utils._Validate(MenuHeader, "MenuHeader", V_STRING) Then GoTo Finally End If Try: Set oLayout = _Document.CurrentController.Frame.LayoutManager Set oMenuBar = oLayout.getElement("private:resource/menubar/menubar").XMenuBar ' Search the menu identifier to remove by its name, Mark its position With oMenuBar iMenuPosition = -1 For i = 0 To .ItemCount - 1 iMenuId = .getItemId(i) sName = Replace(.getItemText(iMenuId), cstTilde, "") If MenuHeader= sName Then iMenuPosition = i Exit For End If Next i ' Remove the found menu item If iMenuPosition >= 0 Then .removeItem(iMenuPosition, 1) bRemove = True End If End With Finally: RemoveMenu = bRemove ScriptForge.SF_Utils._ExitFunction(cstThisSub) Exit Function Catch: GoTo Finally End Function ' SFDocuments.SF_Document.RemoveMenu REM ----------------------------------------------------------------------------- Public Sub RunCommand(Optional ByVal Command As Variant) ''' Run on the document the given menu command. The command is executed without arguments ''' A few typical commands: ''' Save, SaveAs, ExportToPDF, SetDocumentProperties, Undo, Copy, Paste, ... ''' Dozens can be found in the directory $install/share/config/soffice.cfg/modules ''' Args: ''' Command: Case-sensitive. The command itself is not checked. ''' If nothing happens, then the command is probably wrong ''' Returns: ''' Examples: ''' oDoc.RunCommand("About") Dim oDispatch ' com.sun.star.frame.DispatchHelper Const cstThisSub = "SFDocuments.Document.RunCommand" Const cstSubArgs = "Command" If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch Check: If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then If Not _IsStillAlive() Then GoTo Finally If Not ScriptForge.SF_Utils._Validate(Command, "Command", V_STRING) Then GoTo Finally End If Try: Set oDispatch = ScriptForge.SF_Utils._GetUNOService("DispatchHelper") oDispatch.executeDispatch(_Frame, ".uno:" & Command, "", 0, Array()) Finally: ScriptForge.SF_Utils._ExitFunction(cstThisSub) Exit Sub Catch: GoTo Finally End Sub ' SFDocuments.SF_Document.RunCommand REM ----------------------------------------------------------------------------- Public Function Save() As Boolean ''' Store the document to the file location from which it was loaded ''' Ignored if the document was not modified ''' Args: ''' Returns: ''' False if the document could not be saved ''' Exceptions: ''' DOCUMENTSAVEERROR The file has been opened readonly or was opened as new and was not yet saved ''' Examples: ''' If Not oDoc.Save() Then ''' ' ... Dim bSaved As Boolean ' return value Const cstThisSub = "SFDocuments.Document.Save" Const cstSubArgs = "" If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch bSaved = False Check: ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) If Not _IsStillAlive() Then GoTo Finally bSaved = False Try: With _Component If .isReadonly() Or Not .hasLocation() Then GoTo CatchReadonly If .IsModified() Then .store() bSaved = True End If End With Finally: Save = bSaved ScriptForge.SF_Utils._ExitFunction(cstThisSub) Exit Function Catch: GoTo Finally CatchReadonly: ScriptForge.SF_Exception.RaiseFatal(DOCUMENTSAVEERROR, "FileName", _FileIdent()) GoTo Finally End Function ' SFDocuments.SF_Document.Save REM ----------------------------------------------------------------------------- Public Function SaveAs(Optional ByVal FileName As Variant _ , Optional ByVal Overwrite As Variant _ , Optional ByVal Password As Variant _ , Optional ByVal FilterName As Variant _ , Optional ByVal FilterOptions As Variant _ ) As Boolean ''' Store the document to the given file location ''' The new location becomes the new file name on which simple Save method calls will be applied ''' Args: ''' FileName: Identifies the file where to save. It must follow the SF_FileSystem.FileNaming notation ''' Overwrite: True if the destination file may be overwritten (default = False) ''' Password: Use to protect the document ''' FilterName: the name of a filter that should be used for saving the document ''' If present, the filter must exist ''' FilterOptions: an optional string of options associated with the filter ''' Returns: ''' False if the document could not be saved ''' Exceptions: ''' DOCUMENTSAVEASERROR The destination has its readonly attribute set or overwriting rejected ''' Examples: ''' oDoc.SaveAs("C:\Me\Copy2.odt", Overwrite := True) Dim bSaved As Boolean ' return value Dim oFilterFactory As Object ' com.sun.star.document.FilterFactory Dim oSfa As Object ' com.sun.star.ucb.SimpleFileAccess Dim sFile As String ' Alias of FileName Dim vProperties As Variant ' Array of com.sun.star.beans.PropertyValue Dim FSO As Object ' SF_FileSystem Const cstThisSub = "SFDocuments.Document.SaveAs" Const cstSubArgs = "FileName, [Overwrite=False], [Password=""""], [FilterName=""""], [FilterOptions=""""]" If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo CatchError bSaved = False Check: If IsMissing(Overwrite) Or IsEmpty(Overwrite) Then Overwrite = False If IsMissing(Password) Or IsEmpty(Password) Then Password = "" If IsMissing(FilterName) Or IsEmpty(FilterName) Then FilterName = "" If IsMissing(FilterOptions) Or IsEmpty(FilterOptions) Then FilterOptions = "" If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then If Not _IsStillAlive() Then GoTo Finally If Not SF_Utils._ValidateFile(FileName, "FileName") Then GoTo Finally If Not SF_Utils._Validate(Overwrite, "Overwrite", ScriptForge.V_BOOLEAN) Then GoTo Finally If Not SF_Utils._Validate(Password, "Password", V_STRING) Then GoTo Finally If Not SF_Utils._Validate(FilterName, "FilterName", V_STRING) Then GoTo Finally If Not SF_Utils._Validate(FilterOptions, "FilterOptions", V_STRING) Then GoTo Finally End If ' Check that the filter exists If Len(FilterName) > 0 Then Set oFilterFactory = ScriptForge.SF_Utils._GetUNOService("FilterFactory") If Not oFilterFactory.hasByName(FilterName) Then GoTo CatchError End If ' Check destination file overwriting Set FSO = CreateScriptService("FileSystem") sFile = FSO._ConvertToUrl(FileName) If FSO.FileExists(FileName) Then If Overwrite = False Then GoTo CatchError Set oSfa = ScriptForge.SF_Utils._GetUNOService("FileAccess") If oSfa.isReadonly(sFile) Then GoTo CatchError End If Try: ' Setup arguments If Len(Password) + Len(FilterName) = 0 Then vProperties = Array() Else vProperties = Array( _ ScriptForge.SF_Utils._MakePropertyValue("FilterName", FilterName) _ , ScriptForge.SF_Utils._MakePropertyValue("FilterOptions", FilterOptions) _ ) If Len(Password) > 0 Then ' Password is to add only if <> "" !? vProperties = ScriptForge.SF_Array.Append(vProperties _ , ScriptForge.SF_Utils._MakePropertyValue("Password", Password)) End If End If _Component.StoreAsURL(sFile, vProperties) ' Remind the new file name _WindowFileName = sFile _WindowName = FSO.GetName(FileName) bSaved = True Finally: SaveAs = bSaved ScriptForge.SF_Utils._ExitFunction(cstThisSub) Exit Function Catch: GoTo Finally CatchError: ScriptForge.SF_Exception.RaiseFatal(DOCUMENTSAVEASERROR, "FileName", FileName, "Overwrite", Overwrite _ , "FilterName", FilterName) GoTo Finally End Function ' SFDocuments.SF_Document.SaveAs REM ----------------------------------------------------------------------------- Public Function SaveCopyAs(Optional ByVal FileName As Variant _ , Optional ByVal Overwrite As Variant _ , Optional ByVal Password As Variant _ , Optional ByVal FilterName As Variant _ , Optional ByVal FilterOptions As Variant _ ) As Boolean ''' Store a copy or export the document to the given file location ''' The actual location is unchanged ''' Args: ''' FileName: Identifies the file where to save. It must follow the SF_FileSystem.FileNaming notation ''' Overwrite: True if the destination file may be overwritten (default = False) ''' Password: Use to protect the document ''' FilterName: the name of a filter that should be used for saving the document ''' If present, the filter must exist ''' FilterOptions: an optional string of options associated with the filter ''' Returns: ''' False if the document could not be saved ''' Exceptions: ''' DOCUMENTSAVEASERROR The destination has its readonly attribute set or overwriting rejected ''' Examples: ''' oDoc.SaveCopyAs("C:\Me\Copy2.odt", Overwrite := True) Dim bSaved As Boolean ' return value Dim oFilterFactory As Object ' com.sun.star.document.FilterFactory Dim oSfa As Object ' com.sun.star.ucb.SimpleFileAccess Dim sFile As String ' Alias of FileName Dim vProperties As Variant ' Array of com.sun.star.beans.PropertyValue Dim FSO As Object ' SF_FileSystem Const cstThisSub = "SFDocuments.Document.SaveCopyAs" Const cstSubArgs = "FileName, [Overwrite=False], [Password=""""], [FilterName=""""], [FilterOptions=""""]" If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo CatchError bSaved = False Check: If IsMissing(Overwrite) Or IsEmpty(Overwrite) Then Overwrite = False If IsMissing(Password) Or IsEmpty(Password) Then Password = "" If IsMissing(FilterName) Or IsEmpty(FilterName) Then FilterName = "" If IsMissing(FilterOptions) Or IsEmpty(FilterOptions) Then FilterOptions = "" If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then If Not _IsStillAlive() Then GoTo Finally If Not SF_Utils._ValidateFile(FileName, "FileName") Then GoTo Finally If Not SF_Utils._Validate(Overwrite, "Overwrite", ScriptForge.V_BOOLEAN) Then GoTo Finally If Not SF_Utils._Validate(Password, "Password", V_STRING) Then GoTo Finally If Not SF_Utils._Validate(FilterName, "FilterName", V_STRING) Then GoTo Finally If Not SF_Utils._Validate(FilterOptions, "FilterOptions", V_STRING) Then GoTo Finally End If ' Check that the filter exists If Len(FilterName) > 0 Then Set oFilterFactory = ScriptForge.SF_Utils._GetUNOService("FilterFactory") If Not oFilterFactory.hasByName(FilterName) Then GoTo CatchError End If ' Check destination file overwriting Set FSO = CreateScriptService("FileSystem") sFile = FSO._ConvertToUrl(FileName) If FSO.FileExists(FileName) Then If Overwrite = False Then GoTo CatchError Set oSfa = ScriptForge.SF_Utils._GetUNOService("FileAccess") If oSfa.isReadonly(sFile) Then GoTo CatchError End If Try: ' Setup arguments If Len(Password) + Len(FilterName) = 0 Then vProperties = Array() Else vProperties = Array( _ ScriptForge.SF_Utils._MakePropertyValue("FilterName", FilterName) _ , ScriptForge.SF_Utils._MakePropertyValue("FilterOptions", FilterOptions) _ ) If Len(Password) > 0 Then ' Password is to add only if <> "" !? vProperties = ScriptForge.SF_Array.Append(vProperties _ , ScriptForge.SF_Utils._MakePropertyValue("Password", Password)) End If End If _Component.StoreToURL(sFile, vProperties) bSaved = True Finally: SaveCopyAs = bSaved ScriptForge.SF_Utils._ExitFunction(cstThisSub) Exit Function Catch: GoTo Finally CatchError: ScriptForge.SF_Exception.RaiseFatal(DOCUMENTSAVEASERROR, "FileName", FileName, "Overwrite", Overwrite _ , "FilterName", FilterName) GoTo Finally End Function ' SFDocuments.SF_Document.SaveCopyAs REM ----------------------------------------------------------------------------- Public Function SetPrinter(Optional ByVal Printer As Variant _ , Optional ByVal Orientation As Variant _ , Optional ByVal PaperFormat As Variant _ , Optional ByRef _PrintComponent As Variant _ ) As Boolean ''' Define the printer options for the document ''' Args: ''' Printer: the name of the printer queue where to print to ''' When absent or space, the default printer is set ''' Orientation: either "PORTRAIT" or "LANDSCAPE". Left unchanged when absent ''' PaperFormat: one of next values ''' "A3", "A4", "A5", "B4", "B5", "LETTER", "LEGAL", "TABLOID" ''' Left unchanged when absent ''' _PrintComponent: undocumented argument to determine the component ''' Useful typically to apply printer settings on a Base form document ''' Returns: ''' True when successful ''' Examples: ''' oDoc.SetPrinter(Orientation := "PORTRAIT") Dim bPrinter As Boolean ' Return value Dim vPrinters As Variant ' Array of known printers Dim vOrientations As Variant ' Array of allowed paper orientations Dim vPaperFormats As Variant ' Array of allowed formats Dim vPrinterSettings As Variant ' Array of property values Dim oPropertyValue As New com.sun.star.beans.PropertyValue ' A single property value item Const cstThisSub = "SFDocuments.Document.SetPrinter" Const cstSubArgs = "[Printer=""""], [Orientation=""PORTRAIT""|""LANDSCAPE""]" _ & ", [PaperFormat=""A3""|""A4""|""A5""|""B4""|""B5""|""LETTER""|""LEGAL""|""TABLOID""" If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch bPrinter = False Check: If IsMissing(Printer) Or IsEmpty(Printer) Then Printer = "" If IsMissing(Orientation) Or IsEmpty(Orientation) Then Orientation = "" If IsMissing(PaperFormat) Or IsEmpty(PaperFormat) Then PaperFormat = "" If IsMissing(_PrintComponent) Or IsEmpty(_PrintComponent) Then Set _PrintComponent = _Component ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) ' Unconditional validation If Not _IsStillAlive() Then GoTo Finally If VarType(Printer) = V_STRING Then vPrinters = ScriptForge.SF_Platform.Printers If Len(Printer) > 0 Then If Not ScriptForge.SF_Utils._Validate(Printer, "Printer", V_STRING, vPrinters) Then GoTo Finally End If Else If Not ScriptForge.SF_Utils._Validate(Printer, "Printer", V_STRING) Then GoTo Finally ' Manage here the VarType error End If If VarType(Orientation) = V_STRING Then vOrientations = Array("PORTRAIT", "LANDSCAPE") If Len(Orientation) > 0 Then If Not ScriptForge.SF_Utils._Validate(Orientation, "Orientation", V_STRING, vOrientations) Then GoTo Finally End If Else If Not ScriptForge.SF_Utils._Validate(Orientation, "Orientation", V_STRING) Then GoTo Finally End If If VarType(PaperFormat) = V_STRING Then vPaperFormats = Array("A3", "A4", "A5", "B4", "B5", "LETTER", "LEGAL", "TABLOID") If Len(PaperFormat) > 0 Then If Not ScriptForge.SF_Utils._Validate(PaperFormat, "PaperFormat", V_STRING, vPaperFormats) Then GoTo Finally End If Else If Not ScriptForge.SF_Utils._Validate(PaperFormat, "PaperFormat", V_STRING) Then GoTo Finally End If Try: With _PrintComponent Set oPropertyValue = ScriptForge.SF_Utils._MakePropertyValue("Name", Iif(Len(Printer) > 0, Printer, vPrinters(0))) vPrinterSettings = Array(oPropertyValue) If Len(Orientation) > 0 Then vPrinterSettings = ScriptForge.SF_Utils._SetPropertyValue(vPrinterSettings, "PaperOrientation" _ , ScriptForge.SF_Array.IndexOf(vOrientations, Orientation, CaseSensitive := False)) End If If Len(PaperFormat) > 0 Then vPrinterSettings = ScriptForge.SF_Utils._SetPropertyValue(vPrinterSettings, "PaperFormat" _ , ScriptForge.SF_Array.IndexOf(vPaperFormats, PaperFormat, CaseSensitive := False)) End If .setPrinter(vPrinterSettings) End With bPrinter = True Finally: SetPrinter = bPrinter ScriptForge.SF_Utils._ExitFunction(cstThisSub) Exit Function Catch: GoTo Finally End Function ' SFDocuments.SF_Document.SetPrinter REM ----------------------------------------------------------------------------- Private Function SetProperty(Optional ByVal psProperty As String _ , Optional ByVal pvValue As Variant _ ) As Boolean ''' Set the new value of the named property ''' Args: ''' psProperty: the name of the property ''' pvValue: the new value of the given property ''' Returns: ''' True if successful Dim bSet As Boolean ' Return value Static oSession As Object ' Alias of SF_Session Dim cstThisSub As String Const cstSubArgs = "Value" If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch bSet = False cstThisSub = "SFDocuments.Document.set" & psProperty If IsMissing(pvValue) Then pvValue = Empty 'ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) ' Validation done in Property Lets If IsNull(oSession) Then Set oSession = ScriptForge.SF_Services.CreateScriptService("Session") bSet = True Select Case UCase(psProperty) Case UCase("CustomProperties") CustomProperties = pvValue Case UCase("Description") Description = pvValue Case UCase("Keywords") Keywords = pvValue Case UCase("Subject") Subject = pvValue Case UCase("Title") Title = pvValue Case Else bSet = False End Select Finally: SetProperty = bSet 'ScriptForge.SF_Utils._ExitFunction(cstThisSub) Exit Function Catch: GoTo Finally End Function ' SFDocuments.SF_Document.SetProperty REM =========================================================== PRIVATE FUNCTIONS REM ----------------------------------------------------------------------------- Private Function _FileIdent() As String ''' Returns a file identification from the information that is currently available ''' Useful e.g. for display in error messages _FileIdent = Iif(Len(_WindowFileName) > 0, SF_FileSystem._ConvertFromUrl(_WindowFileName), _WindowTitle) End Function ' SFDocuments.SF_Document._FileIdent REM ----------------------------------------------------------------------------- Private Function _IsStillAlive(Optional ByVal pbForUpdate As Boolean _ , Optional ByVal pbError As Boolean _ ) As Boolean ''' Returns True if the document has not been closed manually or incidentally since the last use ''' If dead the actual instance is disposed. The execution is cancelled when pbError = True (default) ''' Args: ''' pbForUpdate: if True (default = False), check additionally if document is open for editing ''' pbError: if True (default), raise a fatal error Dim bAlive As Boolean ' Return value Dim sFileName As String ' File identification used to display error message On Local Error GoTo Catch ' Anticipate DisposedException errors or alike If IsMissing(pbForUpdate) Then pbForUpdate = False If IsMissing(pbError) Then pbError = True Try: ' Check existence of document bAlive = Not IsNull(_Frame) If bAlive Then bAlive = Not IsNull(_Component) If bAlive Then bAlive = Not IsNull(_Component.CurrentController) ' Check document is not read only If bAlive And pbForUpdate Then If _Component.isreadonly() Then GoTo CatchReadonly End If Finally: _IsStillAlive = bAlive Exit Function Catch: bAlive = False On Error GoTo 0 sFileName = _FileIdent() Dispose() If pbError Then ScriptForge.SF_Exception.RaiseFatal(DOCUMENTDEADERROR, sFileName) GoTo Finally CatchReadonly: bAlive = False If pbError Then ScriptForge.SF_Exception.RaiseFatal(DOCUMENTREADONLYERROR, "Document", _FileIdent()) GoTo Finally End Function ' SFDocuments.SF_Document._IsStillAlive REM ----------------------------------------------------------------------------- Private Sub _LoadDocumentProperties() ''' Create dictionary with document properties as entries/ Custom properties are excluded ''' Document is presumed still alive ''' Special values: ''' Only valid dates are taken ''' Statistics are exploded in subitems. Subitems are specific to document type ''' Keywords are joined ''' Language is aligned on L10N convention la-CO Dim oProperties As Object ' Document properties Dim vNamedValue As Variant ' com.sun.star.beans.NamedValue If IsNull(_DocumentProperties) Then Set oProperties = _Component.getDocumentProperties Set _DocumentProperties = CreateScriptService("Dictionary") With _DocumentProperties .Add("Author", oProperties.Author) .Add("AutoloadSecs", oProperties.AutoloadSecs) .Add("AutoloadURL", oProperties.AutoloadURL) If oProperties.CreationDate.Year > 0 Then .Add("CreationDate", CDateFromUnoDateTime(oProperties.CreationDate)) .Add("DefaultTarget", oProperties.DefaultTarget) .Add("Description", oProperties.Description) ' The description can be multiline ' DocumentStatistics : number and names of statistics depend on document type For Each vNamedValue In oProperties.DocumentStatistics .Add(vNamedValue.Name, vNamedValue.Value) Next vNamedValue .Add("EditingDuration", oProperties.EditingDuration) .Add("Generator", oProperties.Generator) .Add("Keywords", Join(oProperties.Keywords, ", ")) .Add("Language", oProperties.Language.Language & Iif(Len(oProperties.Language.Country) > 0, "-" & oProperties.Language.Country, "")) If oProperties.ModificationDate.Year > 0 Then .Add("ModificationDate", CDateFromUnoDateTime(oProperties.ModificationDate)) If oProperties.PrintDate.Year > 0 Then .Add("PrintDate", CDateFromUnoDateTime(oProperties.PrintDate)) .Add("PrintedBy", oProperties.PrintedBy) .Add("Subject", oProperties.Subject) If oProperties.TemplateDate.Year > 0 Then .Add("TemplateDate", CDateFromUnoDateTime(oProperties.TemplateDate)) .Add("TemplateName", oProperties.TemplateName) .Add("TemplateURL", oProperties.TemplateURL) .Add("Title", oProperties.Title) End With End If End Sub ' SFDocuments.SF_Document._LoadDocumentProperties REM ----------------------------------------------------------------------------- Private Function _PropertyGet(Optional ByVal psProperty As String) As Variant ''' Return the value of the named property ''' Args: ''' psProperty: the name of the property Dim oProperties As Object ' Document or Custom properties Dim cstThisSub As String Const cstSubArgs = "" _PropertyGet = False Select Case _DocumentType Case "Calc" : cstThisSub = "SFDocuments.SF_" & _DocumentType & ".get" & psProperty Case Else : cstThisSub = "SFDocuments.SF_Document.get" & psProperty End Select ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) If Not _IsStillAlive() Then GoTo Finally Select Case psProperty Case "CustomProperties" _CustomProperties = CreateScriptService("Dictionary") ' Always reload as updates could have been done manually by user _CustomProperties.ImportFromPropertyValues(_Component.getDocumentProperties().UserDefinedProperties.getPropertyValues) _PropertyGet = _CustomProperties Case "Description" _PropertyGet = _Component.DocumentProperties.Description Case "DocumentProperties" _LoadDocumentProperties() ' Always reload as updates could have been done manually by user Set _PropertyGet = _DocumentProperties Case "DocumentType" _PropertyGet = _DocumentType Case "IsBase", "IsCalc", "IsDraw", "IsImpress", "IsMath", "IsWriter" _PropertyGet = ( Mid(psProperty, 3) = _DocumentType ) Case "Keywords" _PropertyGet = Join(_Component.DocumentProperties.Keywords, ", ") Case "Readonly" _PropertyGet = _Component.isReadonly() Case "Subject" _PropertyGet = _Component.DocumentProperties.Subject Case "Title" _PropertyGet = _Component.DocumentProperties.Title Case "XComponent" Set _PropertyGet = _Component Case Else _PropertyGet = Null End Select Finally: ScriptForge.SF_Utils._ExitFunction(cstThisSub) Exit Function End Function ' SFDocuments.SF_Document._PropertyGet REM ----------------------------------------------------------------------------- Private Function _Repr() As String ''' Convert the SF_Document instance to a readable string, typically for debugging purposes (DebugPrint ...) ''' Args: ''' Return: ''' "[DOCUMENT]: Type - File" _Repr = "[Document]: " & _DocumentType & " - " & _FileIdent() End Function ' SFDocuments.SF_Document._Repr REM ============================================ END OF SFDOCUMENTS.SF_DOCUMENT