2246 lines
No EOL
101 KiB
XML
2246 lines
No EOL
101 KiB
XML
<?xml version="1.0" encoding="UTF-8"?>
|
|
<!DOCTYPE script:module PUBLIC "-//OpenOffice.org//DTD OfficeDocument 1.0//EN" "module.dtd">
|
|
<script:module xmlns:script="http://openoffice.org/2000/script" script:name="SF_Document" script:language="StarBasic" script:moduleType="normal">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"
|
|
|
|
Private Const UNKNOWNFILEERROR = "UNKNOWNFILEERROR"
|
|
|
|
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, ...
|
|
Private _DocumentSettings As Object ' com.sun.star.XXX.DocumentSettings (XXX = sheet, text, drawing or presentation)
|
|
|
|
' 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
|
|
|
|
' Cache for static toolbar descriptions
|
|
Private _Toolbars As Object ' SF_Dictionary instance to hold toolbars stored in application or in document
|
|
|
|
' List of standard context menus
|
|
Private _ContextMenus As Variant ' Array of ResourceURL strings
|
|
|
|
' Style descriptor
|
|
Type StyleDescriptor
|
|
Family As Object
|
|
StyleName As String
|
|
DisplayName As String
|
|
IsUsed As Boolean
|
|
BuiltIn As Boolean
|
|
Category As String
|
|
ParentStyle As String
|
|
XStyle As Object
|
|
End Type
|
|
|
|
Private _StyleFamilies As Variant ' Array of available style families
|
|
|
|
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 _DocumentSettings = Nothing
|
|
Set _DocumentProperties = Nothing
|
|
Set _CustomProperties = Nothing
|
|
Set _Toolbars = Nothing
|
|
_ContextMenus = Array()
|
|
_StyleFamilies = Array()
|
|
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 ExportFilters() As Variant
|
|
''' Returns the list of the export filter names applicable to the current document
|
|
''' as a zero-based array of strings
|
|
''' Import/Export filters are included
|
|
ExportFilters = _PropertyGet("ExportFilters")
|
|
End Property ' SFDocuments.SF_Document.ExportFilters
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Property Get FileSystem() As String
|
|
''' Returns the root of the document's virtual file system
|
|
''' The "FileSystem" service may be used to explore it, as long as the document remains open
|
|
''' The property is not applicable to Base documents
|
|
''' Example:
|
|
''' Dim sRoot As String, FSO
|
|
''' sRoot = oDoc.FileSystem
|
|
''' Set FSO = CreateScriptService("FileSystem")
|
|
''' MsgBox FSO.FolderExists(FSO.BuildPath(sRoot, "Pictures"))
|
|
FileSystem = _PropertyGet("FileSystem")
|
|
End Property ' SFDocuments.SF_Document.FileSystem
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Property Get ImportFilters() As Variant
|
|
''' Returns the list of the import filter names applicable to the current document
|
|
''' as a zero-based array of strings
|
|
''' Import/Export filters are included
|
|
ImportFilters = _PropertyGet("ImportFilters")
|
|
End Property ' SFDocuments.SF_Document.ImportFilters
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Property Get IsAlive() As Boolean
|
|
IsAlive = _PropertyGet("IsAlive")
|
|
End Property ' SFDocuments.SF_Document.IsAlive
|
|
|
|
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 IsFormDocument() As Boolean
|
|
IsFormDocument = _PropertyGet("IsFormDocument")
|
|
End Property ' SFDocuments.SF_Document.IsFormDocument
|
|
|
|
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 StyleFamilies() As Variant
|
|
''' Returns the list of available style families, as an array of strings
|
|
StyleFamilies = _PropertyGet("StyleFamilies")
|
|
End Property ' SFDocuments.SF_Document.StyleFamilies
|
|
|
|
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 -----------------------------------------------------------------------------
|
|
Property Get XDocumentSettings() As Variant
|
|
''' Gives access to a bunch of additional properties, specific to the document's type, about the document
|
|
''' Returns Nothing or a com.sun.star.XXX.DocumentSettings, XXX = text, sheet, drawing or presentation.
|
|
XDocumentSettings = _PropertyGet("XDocumentSettings")
|
|
End Property ' SFDocuments.SF_Document.XDocumentSettings
|
|
|
|
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)
|
|
If .IsMinimized Then .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 = Not _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:
|
|
On Local Error GoTo 0
|
|
GoTo Finally
|
|
End Function ' SFDocuments.SF_Document.CloseDocument
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Public Function ContextMenus(Optional ByVal ContextMenuName As Variant _
|
|
, Optional ByVal SubmenuChar As Variant _
|
|
) As Variant
|
|
''' Returns either a list of the available ContextMenu names in the actual document
|
|
''' or a SFWidgets.ContextMenu object instance.
|
|
''' Args:
|
|
''' ContextMenuName: the usual name of one of the available ContextMenus
|
|
''' SubmenuChar: Delimiter used in menu trees
|
|
''' Returns:
|
|
''' A zero-based array of ContextMenu names when there is no argument,
|
|
''' or a new ContextMenu object instance from the SFWidgets library.
|
|
|
|
Const cstThisSub = "SFDocuments.Document.ContextMenus"
|
|
Const cstSubArgs = "[ContextMenuName=""""], [SubmenuChar="">""]"
|
|
|
|
If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
|
|
|
|
Check:
|
|
If IsMissing(ContextMenuName) Or IsEmpty(ContextMenuName) Then ContextMenuName = ""
|
|
If IsMissing(SubmenuChar) Or IsEmpty(SubmenuChar) Then SubmenuChar = ">"
|
|
If UBound(_ContextMenus) < 0 Then _ContextMenus = _ListContextMenus()
|
|
If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
|
|
If Not _IsStillAlive() Then GoTo Finally
|
|
If VarType(ContextMenuName) = V_STRING Then
|
|
If Len(ContextMenuName) > 0 Then
|
|
If Not ScriptForge.SF_Utils._Validate(ContextMenuName, "ContextMenuName", V_STRING, _ContextMenus) Then GoTo Finally
|
|
End If
|
|
Else
|
|
If Not ScriptForge.SF_Utils._Validate(ContextMenuName, "ContextMenuName", V_STRING) Then GoTo Finally ' Manage here the VarType error
|
|
End If
|
|
If Not ScriptForge.SF_Utils._Validate(SubmenuChar, "SubmenuChar", V_STRING) Then GoTo Finally
|
|
End If
|
|
|
|
Try:
|
|
If Len(ContextMenuName) = 0 Then
|
|
ContextMenus = _ContextMenus
|
|
Else
|
|
ContextMenus = CreateScriptService("SFWidgets.ContextMenu" _
|
|
, _Component _
|
|
, "private:resource/popupmenu/" & LCase(ContextMenuName) _
|
|
, SubmenuChar)
|
|
End If
|
|
|
|
Finally:
|
|
ScriptForge.SF_Utils._ExitFunction(cstThisSub)
|
|
Exit Function
|
|
Catch:
|
|
GoTo Finally
|
|
End Function ' SFDocuments.SF_Document.ContextMenus
|
|
|
|
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", Array(V_STRING, ScriptForge.V_NUMERIC)) 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 Sub DeleteStyles(Optional ByVal Family As Variant _
|
|
, Optional ByRef StylesList As Variant _
|
|
)
|
|
''' Delete a single style or an array of styles given by their name(s)
|
|
''' within a specific styles family.
|
|
''' Only user-defined styles may be deleted. Built-in styles are ignored.
|
|
''' Args:
|
|
''' Family: one of the style families present in the actual document, as a case-sensitive string
|
|
''' StylesList: a single style name as a string or an array of style names.
|
|
''' The style names may be localized or not.
|
|
''' The StylesList is typically the output of the execution of a Styles() method.
|
|
''' Returns:
|
|
''' Examples:
|
|
''' ' Remove all unused styles
|
|
''' Const family = "ParagraphStyles"
|
|
''' doc.DeleteStyles(family, doc.Styles(family, Used := False, UserDefined := True))
|
|
|
|
Dim oFamily As Object ' Style names container
|
|
Dim vStylesList As Variant ' Alias of StylesList
|
|
Dim sStyle As String ' A single style name
|
|
Const cstThisSub = "SFDocuments.Document.DeleteStyles"
|
|
Const cstSubArgs = "Family, StylesList"
|
|
|
|
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 UBound(_StyleFamilies) < 0 Then _StyleFamilies = _Component.getStyleFamilies().getElementNames()
|
|
If Not ScriptForge.SF_Utils._Validate(Family, "Family", V_STRING, _StyleFamilies) Then GoTo Finally
|
|
If IsArray(StylesList) Then
|
|
If Not ScriptForge.SF_Utils._ValidateArray(StylesList, "StylesList", 1, V_STRING, True) Then GoTo Finally
|
|
Else
|
|
If Not ScriptForge.SF_Utils._Validate(StylesList, "StylesList", V_STRING) Then GoTo Finally
|
|
End If
|
|
End If
|
|
|
|
Try:
|
|
Set oFamily = _GetStyleFamily(Family)
|
|
If Not IsNull(oFamily) Then
|
|
With oFamily
|
|
If Not IsArray(StylesList) Then vStylesList = Array(StylesList) Else vStylesList = StylesList
|
|
For Each sStyle In vStylesList
|
|
If .hasByName(sStyle) Then .removeByName(sStyle)
|
|
Next sStyle
|
|
End With
|
|
End If
|
|
|
|
Finally:
|
|
ScriptForge.SF_Utils._ExitFunction(cstThisSub)
|
|
Exit Sub
|
|
Catch:
|
|
GoTo Finally
|
|
End Sub ' SFDocuments.SF_Document.DeleteStyles
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Public Sub Echo(Optional ByVal EchoOn As Variant _
|
|
, Optional ByVal Hourglass As Variant _
|
|
)
|
|
''' While a script is executed any display update resulting from that execution
|
|
''' is done immediately.
|
|
''' For performance reasons it might be an advantage to differ the display updates
|
|
''' up to the end of the script.
|
|
''' This is where pairs of Echo() methods to set and reset the removal of the
|
|
''' immediate updates may be beneficial.
|
|
''' Optionally the actual mouse pointer can be modified to the image of an hourglass.
|
|
''' Args:
|
|
''' EchoOn: when False, the display updates are suspended. Default = True.
|
|
''' Multiple calls with EchoOn = False are harmless.
|
|
''' Hourglass: when True, the mouse pointer is changed to an hourglass. Default = False.
|
|
''' The mouse pointer needs to be inside the actual document's window.
|
|
''' Note that it is very likely that at the least manual movement of the mouse,
|
|
''' the operating system or the LibreOffice process will take back the control
|
|
''' of the mouse icon and its usual behaviour.
|
|
''' Returns:
|
|
''' Examples:
|
|
''' oDoc.Echo(False, Hourglass := True)
|
|
''' ' ... "long-lasting" script ...
|
|
''' oDoc.Echo() ' Reset to normal
|
|
|
|
Dim oContainer As Object ' com.sun.star.awt.XWindow
|
|
Dim lPointer As Long ' com.sun.star.awt.SystemPointer constant
|
|
Dim oPointer As Object ' com.sun.star.awt.Pointer
|
|
Const cstThisSub = "SFDocuments.Document.Echo"
|
|
Const cstSubArgs = "[EchoOn=True], [Hourglass=False]"
|
|
|
|
If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
|
|
|
|
Check:
|
|
If IsMissing(EchoOn) Or IsEmpty(EchoOn) Then EchoOn = True
|
|
If IsMissing(Hourglass) Or IsEmpty(Hourglass) Then Hourglass = False
|
|
If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
|
|
If Not _IsStillAlive() Then GoTo Finally
|
|
If Not SF_Utils._Validate(EchoOn, "EchoOn", ScriptForge.V_BOOLEAN) Then GoTo Finally
|
|
If Not SF_Utils._Validate(Hourglass, "Hourglass", ScriptForge.V_BOOLEAN) Then GoTo Finally
|
|
End If
|
|
|
|
Try:
|
|
With _Component
|
|
|
|
Set oContainer = .CurrentController.Frame.GetContainerWindow()
|
|
Set oPointer = CreateUnoService("com.sun.star.awt.Pointer")
|
|
With com.sun.star.awt.SystemPointer
|
|
If Hourglass Then lPointer = .WAIT Else lPointer = .ARROW
|
|
End With
|
|
oPointer.setType(lPointer)
|
|
|
|
' Mouse icon is set when controller is unlocked
|
|
If Not EchoOn Then
|
|
oContainer.setPointer(oPointer)
|
|
.lockControllers()
|
|
Else ' EchoOn = True
|
|
Do While .hasControllersLocked()
|
|
.unlockControllers()
|
|
Loop
|
|
oContainer.setPointer(oPointer)
|
|
End If
|
|
|
|
End With
|
|
|
|
Finally:
|
|
ScriptForge.SF_Utils._ExitFunction(cstThisSub)
|
|
Exit Sub
|
|
Catch:
|
|
GoTo Finally
|
|
End Sub ' SFDocuments.SF_Document.Echo
|
|
|
|
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
|
|
Select Case _DocumentType ' Disguise form documents as a Writer document
|
|
Case "FormDocument" : sFilter = "Writer_pdf_Export"
|
|
Case Else : sFilter = LCase(_DocumentType) & "_pdf_Export"
|
|
End Select
|
|
' 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" _
|
|
, "ContextMenus" _
|
|
, "CreateMenu" _
|
|
, "Echo" _
|
|
, "DeleteStyles" _
|
|
, "ExportAsPDF" _
|
|
, "ImportStylesFromFile" _
|
|
, "PrintOut" _
|
|
, "RemoveMenu" _
|
|
, "RunCommand" _
|
|
, "Save" _
|
|
, "SaveAs" _
|
|
, "SaveCopyAs" _
|
|
, "SetPrinter" _
|
|
, "Styles" _
|
|
, "Toolbars" _
|
|
, "XStyle" _
|
|
)
|
|
|
|
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" _
|
|
, "ExportFilters" _
|
|
, "FileSystem" _
|
|
, "ImportFilters" _
|
|
, "IsAlive" _
|
|
, "IsBase" _
|
|
, "IsCalc" _
|
|
, "IsDraw" _
|
|
, "IsFormDocument" _
|
|
, "IsImpress" _
|
|
, "IsMath" _
|
|
, "IsWriter" _
|
|
, "Keywords" _
|
|
, "Readonly" _
|
|
, "StyleFamilies" _
|
|
, "Subject" _
|
|
, "Title" _
|
|
, "XComponent" _
|
|
, "XDocumentSettings" _
|
|
)
|
|
|
|
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 _
|
|
, ParamArray Args As Variant _
|
|
)
|
|
''' Run on the current document window the given menu command. The command is executed with or without arguments
|
|
''' A few typical commands:
|
|
''' Save, SaveAs, ExportToPDF, SetDocumentProperties, Undo, Copy, Paste, ...
|
|
''' Dozens can be found on next page: https://wiki.documentfoundation.org/Development/DispatchCommands
|
|
''' Args:
|
|
''' Command: Case-sensitive. The command itself is not checked.
|
|
''' If the command does not contain the ".uno:" prefix, it is added.
|
|
''' If nothing happens, then the command is probably wrong
|
|
''' Args: Pairs of arguments name (string), value (any)
|
|
''' Returns:
|
|
''' Examples:
|
|
''' oDoc.RunCommand("EditDoc", "Editable", False) ' Toggle edit mode
|
|
|
|
Dim vArgs As Variant ' Alias of Args
|
|
Dim oDispatch ' com.sun.star.frame.DispatchHelper
|
|
Dim vProps As Variant ' Array of PropertyValues
|
|
Dim vValue As Variant ' A single value argument
|
|
Dim sCommand As String ' Alias of Command
|
|
Dim i As Long
|
|
Const cstPrefix = ".uno:"
|
|
|
|
Const cstThisSub = "SFDocuments.Document.RunCommand"
|
|
Const cstSubArgs = "Command, [arg0Name, arg0Value], [arg1Name, arg1Value], ..."
|
|
|
|
If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
|
|
|
|
Check:
|
|
' When called from a subclass (Calc, Writer, ..) the arguments are gathered into one single array item
|
|
vArgs = Args
|
|
If IsArray(Args) Then
|
|
If UBound(Args) >= 0 Then
|
|
If IsArray(Args(0)) Then vArgs = Args(0)
|
|
End If
|
|
End If
|
|
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
|
|
If Not ScriptForge.SF_Utils._ValidateArray(vArgs, "Args", 1) Then GoTo Finally
|
|
For i = 0 To UBound(vArgs) - 1 Step 2
|
|
If Not ScriptForge.SF_Utils._Validate(vArgs(i), "Arg" & CStr(i/2) & "Name", V_STRING) Then GoTo Finally
|
|
Next i
|
|
End If
|
|
|
|
Try:
|
|
' Build array of property values
|
|
vProps = Array()
|
|
For i = 0 To UBound(vArgs) - 1 Step 2
|
|
If IsEmpty(vArgs(i + 1)) Then vValue = Null Else vValue = vArgs(i + 1)
|
|
vProps = ScriptForge.SF_Array.Append(vProps, ScriptForge.SF_Utils._MakePropertyValue(vArgs(i), vValue))
|
|
Next i
|
|
Set oDispatch = ScriptForge.SF_Utils._GetUNOService("DispatchHelper")
|
|
If ScriptForge.SF_String.StartsWith(Command, cstPrefix) Then sCommand = Command Else sCommand = cstPrefix & Command
|
|
oDispatch.executeDispatch(_Frame, sCommand, "", 0, vProps)
|
|
|
|
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, True) 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 -----------------------------------------------------------------------------
|
|
Public Function Styles(Optional ByVal Family As Variant _
|
|
, Optional ByVal NamePattern As variant _
|
|
, Optional ByVal Used As variant _
|
|
, Optional ByVal UserDefined As Variant _
|
|
, Optional ByVal ParentStyle As Variant _
|
|
, Optional ByVal Category As Variant _
|
|
) As Variant
|
|
''' Returns an array of style names matching the filters given in argument
|
|
''' Args:
|
|
''' Family: one of the style families present in the actual document, as a case-sensitive string
|
|
''' NamePattern: a filter on the style names, as a case-sensitive string pattern
|
|
''' Admitted wildcard are: the "?" represents any single character
|
|
''' the "*" represents zero, one, or multiple characters
|
|
''' The names include the internal and localized names.
|
|
''' Used: when True, the style must be used in the document
|
|
''' When absent, the argument is ignored.
|
|
''' UserDefined: when True, the style must have been added by the user, either in the document or its template
|
|
''' When absent, the argument is ignored.
|
|
''' ParentStyle: when present, only the children of the given, localized or not, parent style name are retained
|
|
''' Category: a case-insensitive string: TEXT, CHAPTER, LIST, INDEX, EXTRA, HTML
|
|
''' For their respective meanings, read https://api.libreoffice.org/docs/idl/ref/namespacecom_1_1sun_1_1star_1_1style_1_1ParagraphStyleCategory.html
|
|
''' The argument is ignored when the Family is not = "ParagraphStyles".
|
|
''' Returns:
|
|
''' An array of style localized names
|
|
''' An error is raised when the Family does not exist.
|
|
''' The returned array may be empty.
|
|
''' Example:
|
|
''' Dim vStyles As Variant
|
|
''' vStyles = doc.Styles("ParagraphStyles") ' All styles in the family
|
|
''' vStyles = doc.Styles("ParagraphStyles", "H*") ' Heading, Heading 1, ...
|
|
''' vStyles = doc.Styles("ParagraphStyles", Used := False, UserDefined := True)
|
|
''' ' All user-defined styles that are not used
|
|
''' vStyles = doc.Styles("ParagraphStyles", ParentStyle := "Standard")
|
|
''' ' All styles derived from the "Default Paragraph Style"
|
|
|
|
Dim vStyles As Variant ' Return value
|
|
Dim sStyle As String ' A single style name
|
|
Dim oFamily As Object ' Style names container
|
|
Dim oStyle As Object ' _StyleDescriptor
|
|
Dim oParentStyle As Object ' _StyleDescriptor
|
|
Dim bValid As Boolean ' When True, a given style passes the filter
|
|
Dim i As Integer
|
|
Const cstCategories = "TEXT,CHAPTER,LIST,INDEX,EXTRA,HTML"
|
|
|
|
Const cstThisSub = "SFDocuments.Document.Styles"
|
|
Const cstSubArgs = "Family, [NamePattern=""*""], [Used=True|False], [UserDefined=True|False], ParentStyle = """"" _
|
|
& ", [Category=""""|""TEXT""|""CHAPTER""|""LIST""|""INDEX""|""EXTRA""|""HTML""]"
|
|
|
|
If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
|
|
vStyles = Array()
|
|
|
|
Check:
|
|
If IsMissing(NamePattern) Or IsEmpty(NamePattern) Then NamePattern = ""
|
|
If IsMissing(Used) Then Used = Empty
|
|
If IsMissing(UserDefined) Then UserDefined = Empty
|
|
If IsMissing(ParentStyle) Or IsEmpty(ParentStyle) Then ParentStyle = ""
|
|
If IsMissing(Category) Or IsEmpty(Category) Then Category = ""
|
|
If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
|
|
If Not _IsStillAlive() Then GoTo Finally
|
|
If UBound(_StyleFamilies) < 0 Then _StyleFamilies = _Component.getStyleFamilies().getElementNames()
|
|
If Not ScriptForge.SF_Utils._Validate(Family, "Family", V_STRING, _StyleFamilies) Then GoTo Finally
|
|
If Not ScriptForge.SF_Utils._Validate(NamePattern, "NamePattern", V_STRING) Then GoTo Finally
|
|
If Not IsEmpty(Used) Then
|
|
If Not ScriptForge.SF_Utils._Validate(Used, "Used", ScriptForge.V_BOOLEAN) Then GoTo Finally
|
|
End If
|
|
If Not IsEmpty(UserDefined) Then
|
|
If Not ScriptForge.SF_Utils._Validate(UserDefined, "UserDefined", ScriptForge.V_BOOLEAN) Then GoTo Finally
|
|
End If
|
|
If Not ScriptForge.SF_Utils._Validate(ParentStyle, "ParentStyle", V_STRING) Then GoTo Finally
|
|
If Not ScriptForge.SF_Utils._Validate(Category, "Category", V_STRING, Split("," & cstCategories, ",")) Then GoTo Finally
|
|
End If
|
|
|
|
Try:
|
|
Set oFamily = _GetStyleFamily(Family)
|
|
If Not IsNull(oFamily) Then
|
|
' Load it with the complete list of styles in the family
|
|
vStyles = oFamily.getElementNames()
|
|
' Scan the list and retain those passing the filter
|
|
For i = 0 To UBound(vStyles)
|
|
sStyle = vStyles(i)
|
|
Set oStyle = _GetStyle(oFamily, sStyle)
|
|
If Not IsNull(oStyle) Then
|
|
With oStyle
|
|
' Pattern ?
|
|
bValid = ( Len(NamePattern) = 0 )
|
|
If Not bValid Then bValid = ScriptForge.SF_String.IsLike(.DisplayName, NamePattern, CaseSensitive := True)
|
|
' Used ?
|
|
If bValid And Not IsEmpty(Used) Then bValid = ( Used = .IsUsed )
|
|
' User defined ?
|
|
If bValid And Not IsEmpty(UserDefined) Then bValid = ( UserDefined = Not .BuiltIn )
|
|
' Parent style ?
|
|
If bValid And Len(ParentStyle) > 0 Then
|
|
Set oParentStyle = _GetStyle(oFamily, .ParentStyle)
|
|
bValid = Not IsNull(oParentStyle) ' The child has a parent
|
|
If bValid Then bValid = ( ParentStyle = oParentStyle.DisplayName Or ParentStyle = oParentStyle.StyleName)
|
|
End If
|
|
' Category ?
|
|
If bValid And Len(Category) > 0 Then bValid = ( UCase(Category) = .Category )
|
|
If bValid Then vStyles(i) = .DisplayName Else vStyles(i) = ""
|
|
End With
|
|
Else
|
|
vStyles(i) = ""
|
|
End If
|
|
Next i
|
|
' Reject when not valid
|
|
vStyles = ScriptForge.SF_Array.TrimArray(vStyles)
|
|
End If
|
|
|
|
Finally:
|
|
Styles = vStyles
|
|
ScriptForge.SF_Utils._ExitFunction(cstThisSub)
|
|
Exit Function
|
|
Catch:
|
|
GoTo Finally
|
|
End Function ' SFDocuments.SF_Document.Styles
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Public Function Toolbars(Optional ByVal ToolbarName As Variant) As Variant
|
|
''' Returns either a list of the available toolbar names in the actual document
|
|
''' or a Toolbar object instance.
|
|
''' Args:
|
|
''' ToolbarName: the usual name of one of the available toolbars
|
|
''' Returns:
|
|
''' A zero-based array of toolbar names when the argument is absent,
|
|
''' or a new Toolbar object instance from the SF_Widgets library.
|
|
|
|
Const cstThisSub = "SFDocuments.Document.Toolbars"
|
|
Const cstSubArgs = "[ToolbarName=""""]"
|
|
|
|
If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
|
|
|
|
Check:
|
|
If IsMissing(ToolbarName) Or IsEmpty(ToolbarName) Then ToolbarName = ""
|
|
If IsNull(_Toolbars) Then _Toolbars = ScriptForge.SF_UI._ListToolbars(_Component)
|
|
If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
|
|
If Not _IsStillAlive() Then GoTo Finally
|
|
If VarType(ToolbarName) = V_STRING Then
|
|
If Len(ToolbarName) > 0 Then
|
|
If Not ScriptForge.SF_Utils._Validate(ToolbarName, "ToolbarName", V_STRING, _Toolbars.Keys()) Then GoTo Finally
|
|
End If
|
|
Else
|
|
If Not ScriptForge.SF_Utils._Validate(ToolbarName, "ToolbarName", V_STRING) Then GoTo Finally ' Manage here the VarType error
|
|
End If
|
|
End If
|
|
|
|
Try:
|
|
If Len(ToolbarName) = 0 Then
|
|
Toolbars = _Toolbars.Keys()
|
|
Else
|
|
Toolbars = CreateScriptService("SFWidgets.Toolbar", _Toolbars.Item(ToolbarName))
|
|
End If
|
|
|
|
Finally:
|
|
ScriptForge.SF_Utils._ExitFunction(cstThisSub)
|
|
Exit Function
|
|
Catch:
|
|
GoTo Finally
|
|
End Function ' SFDocuments.SF_Document.Toolbars
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Public Function XStyle(Optional ByVal Family As Variant _
|
|
, Optional ByVal StyleName As variant _
|
|
) As Object
|
|
''' Returns a com.sun.star.style.Style UNO object corresponding with the arguments
|
|
''' Args:
|
|
''' Family: one of the style families present in the actual document, as a not case-sensitive string
|
|
''' StyleName: one of the styles present in the given family, as a case-sensitive string
|
|
''' The StyleName may be localized or not.
|
|
''' Returns:
|
|
''' A com.sun.star.style.XStyle UNO object or one of its descendants,
|
|
''' like com.sun.star.style.CellStyle or com.sun.star.style.ParagraphStyle etc.
|
|
''' An error is raised when the Family does not exist.
|
|
''' Nothing is returned when the StyleName does not exist in the given Family.
|
|
''' Example:
|
|
''' Dim oStyle As Object
|
|
''' Set oStyle = doc.XStyle("ParagraphStyle", "Heading 2")
|
|
|
|
Dim oXStyle As Object ' Return value
|
|
Dim oFamily As Object ' Style names container
|
|
|
|
Const cstThisSub = "SFDocuments.Document.XStyle"
|
|
Const cstSubArgs = "Family, StyleName"
|
|
|
|
If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
|
|
Set oXStyle = Nothing
|
|
|
|
Check:
|
|
If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
|
|
If Not _IsStillAlive() Then GoTo Finally
|
|
If UBound(_StyleFamilies) < 0 Then _StyleFamilies = _Component.getStyleFamilies().getElementNames()
|
|
If Not ScriptForge.SF_Utils._Validate(Family, "Family", V_STRING, _StyleFamilies) Then GoTo Finally
|
|
If Not ScriptForge.SF_Utils._Validate(StyleName, "StyleName", V_STRING) Then GoTo Finally
|
|
End If
|
|
|
|
Try:
|
|
Set oFamily = _GetStyleFamily(Family)
|
|
If Not IsNull(oFamily) Then
|
|
If oFamily.hasByName(StyleName) Then Set oXStyle = oFamily.getByName(StyleName)
|
|
End If
|
|
|
|
Finally:
|
|
Set XStyle = oXStyle
|
|
ScriptForge.SF_Utils._ExitFunction(cstThisSub)
|
|
Exit Function
|
|
Catch:
|
|
GoTo Finally
|
|
End Function ' SFDocuments.SF_Document.XStyle
|
|
|
|
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
|
|
|
|
' OS notation is used to avoid presence of "%nn" in error messages and wrong parameter substitutions
|
|
_FileIdent = Iif(Len(_WindowFileName) > 0, ConvertFromUrl(_WindowFileName), _WindowTitle)
|
|
|
|
End Function ' SFDocuments.SF_Document._FileIdent
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Private Function _GetFilterNames(ByVal pbExport As Boolean) As Variant
|
|
''' Returns the list of export (pbExport = True) or import filters
|
|
''' applicable to the current document
|
|
''' Args:
|
|
''' pbExport: True for export, False for import
|
|
''' Returns:
|
|
''' A zero-based array of strings
|
|
|
|
Dim vFilters As Variant ' Return value
|
|
Dim sIdentifier As String ' Document service, like com.sun.star.text.TextDocument
|
|
Dim oFilterFactory As Object ' com.sun.star.document.FilterFactory
|
|
Dim vAllFilters As Variant ' The full list of installed filters
|
|
Dim sFilter As String ' A single filter name
|
|
Dim iCount As Integer ' Filters counter
|
|
Dim vFilter As Variant ' A filter descriptor as an array of Name/Value pairs
|
|
Dim sType As String ' The filter type to be compared with the document service
|
|
Dim lFlags As Long ' Read https://wiki.documentfoundation.org/Documentation/DevGuide/Office_Development#Properties_of_a_Filter
|
|
Dim bExport As Boolean ' Filter valid for export when True
|
|
Dim bImport As Boolean ' Filter valid for import when True
|
|
Dim bImportExport As Boolean ' Filter valid both for import and export when True
|
|
|
|
vFilters = Array()
|
|
On Local Error GoTo Finally ' Return empty or partial list if error
|
|
|
|
Try:
|
|
sIdentifier = _Component.Identifier
|
|
Set oFilterFactory = ScriptForge.SF_Utils._GetUNOService("FilterFactory")
|
|
vAllFilters = oFilterFactory.getElementNames()
|
|
ReDim vFilters(0 To UBound(vAllFilters))
|
|
iCount = -1
|
|
|
|
For Each sFilter In vAllFilters
|
|
vFilter = oFilterFactory.getByName(sFilter)
|
|
sType = ScriptForge.SF_Utils._GetPropertyValue(vFilter, "DocumentService")
|
|
If sType = sIdentifier Then
|
|
lFlags = ScriptForge.SF_Utils._GetPropertyValue(vFilter, "Flags")
|
|
' export: flag is even
|
|
' import: flag is odd and flag/2 is even
|
|
' import/export: flag is odd and flag/2 is odd
|
|
bExport = ( lFlags Mod 2 = 0 )
|
|
bImport = ( (lFlags Mod 2 = 1) And ((lFlags \ 2) Mod 2 = 0) )
|
|
bImportExport = ( (lFlags Mod 2 = 1) And ((lFlags \ 2) Mod 2 = 1) )
|
|
' Select filter ?
|
|
If bImportExport _
|
|
Or (pbExport And bExport) _
|
|
Or (Not pbExport And bImport) Then
|
|
iCount = iCount + 1
|
|
vFilters(iCount) = sFilter
|
|
End If
|
|
End If
|
|
Next sFilter
|
|
|
|
If iCount > -1 Then
|
|
ReDim Preserve vFilters(0 To iCount)
|
|
End If
|
|
|
|
Finally:
|
|
_GetFilterNames = vFilters
|
|
Exit Function
|
|
End Function ' SFDocuments.SF_Document._GetFilterNames
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Private Function _GetStyle(ByRef poFamily As Object _
|
|
, Optional ByVal pvDisplayName As Variant _
|
|
, Optional ByVal pvStyleIndex As Variant _
|
|
) As Object
|
|
''' Returns the style descriptor of the style passed as argument in the given family
|
|
''' Args:
|
|
''' poFamily: a com.sun.star.container.XNameContainer/XStyleFamily object
|
|
''' pvDisplayName: case-sensitive string, localized style name as visible in the user interface
|
|
''' pvStyleIndex: index of the style in the family, as an integer
|
|
''' Exactly 1 out of the last 2 arguments must be supplied
|
|
''' Returns:
|
|
''' A StyleDescriptor object or Nothing
|
|
|
|
Dim oStyleDescriptor ' Return value
|
|
Dim oStyle As Object ' com.sun.star.style.XStyle and variants
|
|
Dim bFound As Boolean ' When True, the style has been found in the family
|
|
Dim vCategories As Variant ' Array of category constants
|
|
Dim iCategory As Integer ' Index of vCategories
|
|
Dim oSession As Object : Set oSession = ScriptForge.SF_Services.CreateScriptService("Session")
|
|
Dim i As Integer
|
|
|
|
Const cstCAT0 = "TEXT" ' is applied to styles that are used for common text
|
|
Const cstCAT1 = "CHAPTER" ' is applied to styles that are used as headings
|
|
Const cstCAT2 = "LIST" ' is applied to styles that are used in numberings and lists
|
|
Const cstCAT3 = "INDEX" ' is applied to styles that are used in indexes
|
|
Const cstCAT4 = "EXTRA" ' is applied to styles that are used in special regions like headers, footers, and footnote text
|
|
Const cstCAT5 = "HTML" ' is applied to styles that are used to support HTML
|
|
Const cstCAT = cstCAT0 & "," & cstCAT1 & "," & cstCAT2 & "," & cstCAT3 & "," & cstCAT4 & "," & cstCAT5
|
|
|
|
On Local Error GoTo Catch
|
|
Set oStyleDescriptor = Nothing
|
|
|
|
Check:
|
|
If IsNull(poFamily) Then GoTo Catch
|
|
If IsMissing(pvDisplayName) Or IsEmpty(pvDisplayName) Then pvDisplayName = ""
|
|
If IsMissing(pvStyleIndex) Or IsEmpty(pvStyleIndex) Then pvStyleIndex = -1
|
|
Try:
|
|
' Find style corresponding with the given display name
|
|
With poFamily
|
|
If Len(pvDisplayName) > 0 Then
|
|
bFound = .hasByName(pvDisplayName) ' hasByName searches both for Name and DisplayName attributes here
|
|
If bFound Then Set oStyle = .getByName(pvDisplayName) Else GoTo Catch
|
|
ElseIf pvStyleIndex >= 0 And pvStyleIndex < .Count Then
|
|
Set oStyle = .getByIndex(pvStyleIndex)
|
|
Else
|
|
GoTo Catch ' Should not happen
|
|
End If
|
|
End With
|
|
|
|
' Setup the style descriptor
|
|
Set oStyleDescriptor = New StyleDescriptor
|
|
With oStyleDescriptor
|
|
Set .Family = poFamily
|
|
.StyleName = oStyle.Name
|
|
.DisplayName = oStyle.DisplayName
|
|
.IsUsed = oStyle.isInUse
|
|
.BuiltIn = Not oStyle.isUserDefined()
|
|
.Category = ""
|
|
If oSession.HasUnoProperty(oStyle, "Category") Then
|
|
vCategories = Split(cstCAT, ",")
|
|
iCategory = oStyle.Category
|
|
If iCategory >= 0 And iCategory <= UBound(vCategories) Then .Category = vCategories(iCategory)
|
|
End If
|
|
.ParentStyle = oStyle.ParentStyle
|
|
Set .XStyle = oStyle
|
|
End With
|
|
|
|
Finally:
|
|
Set _GetStyle = oStyleDescriptor
|
|
Exit Function
|
|
Catch:
|
|
Set oStyleDescriptor = Nothing
|
|
GoTo Finally
|
|
End Function ' SFDocuments.SF_Document._GetStyle
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Private Function _GetStyleFamily(ByVal psFamilyName As String) As Object
|
|
''' Returns the style names container corresponding with the argument
|
|
''' Args:
|
|
''' psFamilyName: CellStyles, CharacterStyles, FrameStyles, GraphicsStyles, ListStyles,
|
|
''' NumberingStyles, PageStyles, ParagraphStyles, TableStyles
|
|
''' Returns:
|
|
''' A com.sun.star.container.XNameContainer/XStyleFamily object or Nothing
|
|
|
|
Dim oFamily As Object ' Return value
|
|
Dim oFamilies As Object ' com.sun.star.container.XNameAccess
|
|
Dim iIndex As Integer ' Index in vFamilies of the given argument
|
|
|
|
On Local Error GoTo Catch
|
|
Set oFamily = Nothing
|
|
|
|
Try:
|
|
Set oFamilies = _Component.getStyleFamilies()
|
|
If UBound(_StyleFamilies) < 0 Then _StyleFamilies = oFamilies.getElementNames()
|
|
' oFamilies.hasByName()/getByName() not used here to admit not case-sensitive family names
|
|
iIndex = ScriptForge.SF_Array.IndexOf(_StyleFamilies, psFamilyName, CaseSensitive := False)
|
|
If iIndex >= 0 Then Set oFamily = oFamilies.getByName(_StyleFamilies(iIndex))
|
|
|
|
Finally:
|
|
Set _GetStyleFamily = oFamily
|
|
Exit Function
|
|
Catch:
|
|
Set oFamily = Nothing
|
|
GoTo Finally
|
|
End Function ' SFDocuments.SF_Document._GetStyleFamily
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Public Sub _ImportStylesFromFile(Optional FileName As Variant _
|
|
, Optional ByRef Families As Variant _
|
|
, Optional ByVal Overwrite As variant _
|
|
) As Variant
|
|
''' Load all the styles belonging to one or more style families from a closed file
|
|
''' into the actual document. The actual document must be a Calc or a Writer document.
|
|
''' Are always imported together:
|
|
''' ParagraphStyles and CharacterStyles
|
|
''' NumberingStyles and ListStyles
|
|
''' Args:
|
|
''' FileName: the file from which to load the styles in the FileSystem notation.
|
|
''' The file is presumed to be of the same document type as the actual document
|
|
''' Families: one of the style families present in the actual document, as a case-sensitive string
|
|
''' or an array of such strings. Default = all families
|
|
''' Overwrite: when True, the actual styles may be overwritten. Default = False
|
|
''' Returns:
|
|
''' Exceptions:
|
|
''' UNKNOWNFILEERROR The given file name does not exist
|
|
''' Example:
|
|
''' oDoc.ImportStylesFromFile("C:\...\abc.odt", Families := "ParagraphStyles", Overwrite := True)
|
|
|
|
Dim vFamilies As Variant ' Alias of Families
|
|
Dim oFamilies As Object ' com.sun.star.container.XNameAccess
|
|
Dim vOptions As Variant ' Array of property values
|
|
Dim bAll As Boolean ' When True, ALL style families are considered
|
|
Dim sName As String ' A single name in vOptions
|
|
Dim FSO As Object : Set FSO = ScriptForge.SF_FileSystem
|
|
Dim i As Integer
|
|
Const cstThisSub = "SFDocuments.Document.ImportStylesFromFile"
|
|
Const cstSubArgs = "FileName, [Families], [Overwrite=False]"
|
|
|
|
If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
|
|
|
|
Check:
|
|
If IsMissing(Families) Or IsEmpty(Families) Then Families = ""
|
|
If IsMissing(Overwrite) Or IsEmpty(Overwrite) Then Overwrite = False
|
|
|
|
Set oFamilies = _Component.getStyleFamilies()
|
|
If UBound(_StyleFamilies) < 0 Then _StyleFamilies = oFamilies.getElementNames()
|
|
|
|
If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
|
|
If Not _IsStillAlive() Then GoTo Finally
|
|
If Not ScriptForge.SF_Utils._ValidateFile(FileName, "FileName", False) Then GoTo Finally
|
|
If IsArray(Families) Then
|
|
If Not ScriptForge.SF_Utils._ValidateArray(Families, "Families", 1, V_STRING, True) Then GoTo Finally
|
|
Else
|
|
If Not ScriptForge.SF_Utils._Validate(Families, "Families", V_STRING, ScriptForge.SF_Array.Append(_StyleFamilies, "")) Then GoTo Finally
|
|
End If
|
|
If Not ScriptForge.SF_Utils._Validate(Overwrite, "Overwrite", ScriptForge.V_BOOLEAN) Then GoTo Finally
|
|
End If
|
|
|
|
If Not FSO.FileExists(FileName) Then GoTo CatchNotExists
|
|
If IsArray(Families) Then
|
|
vFamilies = Families
|
|
Else
|
|
bAll = ( Len(Families) = 0 ) ' When Families is absent (= ""), all families should be considered
|
|
vFamilies = Array(Families)
|
|
End If
|
|
|
|
Try:
|
|
With ScriptForge.SF_Utils
|
|
Set vOptions = _Component.getStyleFamilies().getStyleLoaderOptions
|
|
' By default, all style families are imported (True)
|
|
If Not bAll Then
|
|
For i = 0 To UBound(vOptions)
|
|
vOptions(i).Value = False
|
|
Next i
|
|
For i = LBound(vFamilies) To UBound(vFamilies)
|
|
Select Case UCase(vFamilies(i))
|
|
Case "PARAGRAPHSTYLES", "CHARACTERSTYLES" : sName = "TextStyles"
|
|
Case "FRAMESTYLES" : sName = "FrameStyles"
|
|
Case "PAGESTYLES" : sName = "PageStyles"
|
|
Case "NUMBERINGSTYLES", "LISTSTYLES" : sName = "NumberingStyles"
|
|
Case "CELLSTYLES" : sName = "PageStyles"
|
|
Case Else : sName = ""
|
|
End Select
|
|
If Len(sName) > 0 Then Set vOptions = ._SetPropertyValue(vOptions, "Load" & sName, True)
|
|
Next i
|
|
End If
|
|
vOptions = ._SetPropertyValue(vOptions, "OverwriteStyles", Overwrite)
|
|
End With
|
|
|
|
' Finally, import
|
|
oFamilies.loadStylesFromURL(FSO._ConvertToUrl(FileName), vOptions)
|
|
|
|
Finally:
|
|
ScriptForge.SF_Utils._ExitFunction(cstThisSub)
|
|
Exit Sub
|
|
Catch:
|
|
GoTo Finally
|
|
CatchNotExists:
|
|
SF_Exception.RaiseFatal(UNKNOWNFILEERROR, "FileName", FileName)
|
|
GoTo Finally
|
|
End Sub ' SFDocuments.SF_Document._ImportStylesFromFile
|
|
|
|
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 Function _ListContextMenus() As Variant
|
|
''' Returns an array of the usual names of the context menus available in the current document
|
|
|
|
Dim vMenus As Variant ' Return value
|
|
Dim vMenusObj As Variant ' Array of arrays of property values
|
|
Dim oSupplier As Object ' /singletons/com.sun.star.ui.theModuleUIConfigurationManagerSupplier
|
|
Dim sComponentType As String ' Argument to determine the system config manager, ex. "com.sun.star.text.TextDocument"
|
|
Dim oUIConf As Object ' com.sun.star.ui.XUIConfigurationManager
|
|
Dim i As Long
|
|
|
|
On Local Error GoTo Catch
|
|
vMenus = Array()
|
|
|
|
Try:
|
|
Set oSupplier = ScriptForge.SF_Utils._GetUNOService("ModuleUIConfigurationManagerSupplier")
|
|
sComponentType = ScriptForge.SF_UI._GetConfigurationManager(_Component)
|
|
Set oUIConf = oSupplier.getUIConfigurationManager(sComponentType)
|
|
|
|
' Discard menubar, statusbar, ...
|
|
vMenusObj = oUIConf.getUIElementsInfo(com.sun.star.ui.UIElementType.POPUPMENU)
|
|
|
|
' Extract and sort the names
|
|
ReDim vMenus(0 To UBound(vMenusObj))
|
|
For i = 0 To UBound(vMenusObj)
|
|
vMenus(i) = Mid(vMenusObj(i)(0).Value, Len("private:resource/popupmenu/") + 1)
|
|
Next i
|
|
vMenus = ScriptForge.SF_Array.Unique(vMenus, CaseSensitive := True)
|
|
|
|
Finally:
|
|
_ListContextMenus = vMenus
|
|
Exit Function
|
|
Catch:
|
|
On Local Error GoTo 0
|
|
GoTo Finally
|
|
End Function ' SFDocuments.SF_Document._ListContextMenus
|
|
|
|
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 oTransient As Object ' com.sun.star.frame.TransientDocumentsDocumentContentFactory
|
|
Dim oContent As Object ' com.sun.star.comp.ucb.TransientDocumentsContent
|
|
Dim cstThisSub As String
|
|
Const cstSubArgs = ""
|
|
|
|
_PropertyGet = False
|
|
|
|
Select Case _DocumentType
|
|
Case "Base", "Calc", "FormDocument", "Writer"
|
|
cstThisSub = "SFDocuments.SF_" & _DocumentType & ".get" & psProperty
|
|
Case Else : cstThisSub = "SFDocuments.SF_Document.get" & psProperty
|
|
End Select
|
|
ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs)
|
|
If psProperty <> "IsAlive" Then
|
|
If Not _IsStillAlive() Then GoTo Finally
|
|
End If
|
|
|
|
Select Case psProperty
|
|
Case "CustomProperties"
|
|
_CustomProperties = CreateScriptService("Dictionary", True) ' Always reload as updates could have been done manually by user
|
|
' (with case-sensitive comparison of keys)
|
|
_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 "ExportFilters"
|
|
_PropertyGet = _GetFilterNames(True)
|
|
Case "FileSystem"
|
|
' Natural choice would have been to use the component.RunTimeUID property
|
|
' However it is optional in the OfficeDocument service and not available for Base documents
|
|
' Below a more generic alternative derived from the get_document_uri() method found in apso.py
|
|
Set oTransient = ScriptForge.SF_Utils._GetUnoService("TransientDocumentFactory")
|
|
Set oContent = oTransient.createDocumentContent(_Component)
|
|
_PropertyGet = oContent.getIdentifier().ContentIdentifier & "/"
|
|
Case "ImportFilters"
|
|
_PropertyGet = _GetFilterNames(False)
|
|
Case "IsAlive"
|
|
_PropertyGet = _IsStillAlive(False, False)
|
|
Case "IsBase", "IsCalc", "IsDraw", "IsFormDocument", "IsImpress", "IsMath", "IsWriter"
|
|
_PropertyGet = ( Mid(psProperty, 3) = _DocumentType )
|
|
Case "Keywords"
|
|
_PropertyGet = Join(_Component.DocumentProperties.Keywords, ", ")
|
|
Case "Readonly"
|
|
_PropertyGet = _Component.isReadonly()
|
|
Case "StyleFamilies"
|
|
If UBound(_StyleFamilies) < 0 Then _StyleFamilies = _Component.getStyleFamilies().getElementNames()
|
|
_PropertyGet = _StyleFamilies
|
|
Case "Subject"
|
|
_PropertyGet = _Component.DocumentProperties.Subject
|
|
Case "Title"
|
|
_PropertyGet = _Component.DocumentProperties.Title
|
|
Case "XComponent"
|
|
Set _PropertyGet = _Component
|
|
Case "XDocumentSettings"
|
|
With _Component
|
|
If IsNull(_DocumentSettings) Then
|
|
Select Case _DocumentType
|
|
Case "Calc" : Set _DocumentSettings = .createInstance("com.sun.star.sheet.DocumentSettings")
|
|
Case "Draw" : Set _DocumentSettings = .createInstance("com.sun.star.drawing.DocumentSettings")
|
|
Case "FormDocument", "Writer"
|
|
Set _DocumentSettings = .createInstance("com.sun.star.text.DocumentSettings")
|
|
Case "Impress" : Set _DocumentSettings = .createInstance("com.sun.star.presentation.DocumentSettings")
|
|
Case Else : Set _DocumentSettings = Nothing
|
|
End Select
|
|
End If
|
|
Set _PropertyGet = _DocumentSettings
|
|
End With
|
|
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
|
|
</script:module> |