diff options
| author | Jean-Pierre Ledure <jp@ledure.be> | 2020-11-05 16:28:52 +0100 |
|---|---|---|
| committer | Jean-Pierre Ledure <jp@ledure.be> | 2020-11-05 16:28:52 +0100 |
| commit | cdedc00ff579980c73b3cdb5fee0c78c1e111361 (patch) | |
| tree | 923d2d3158118133484befaa7fc74d5a5c5dfe9c /wizards | |
| parent | 9597440731cad723434df0867dbe97506201df29 (diff) | |
ScriptForge - SFDocuments library
Additional "LibreOffice Macros & Dialogs" library
Change-Id: I1eadae02d2bbd5d549d9a5bbcec2b83682c7c2ab
Diffstat (limited to 'wizards')
| -rw-r--r-- | wizards/source/sfdocuments/SF_Base.xba | 464 | ||||
| -rw-r--r-- | wizards/source/sfdocuments/SF_Calc.xba | 2843 | ||||
| -rw-r--r-- | wizards/source/sfdocuments/SF_Document.xba | 1010 | ||||
| -rw-r--r-- | wizards/source/sfdocuments/SF_Register.xba | 198 | ||||
| -rw-r--r-- | wizards/source/sfdocuments/__License.xba | 26 | ||||
| -rw-r--r-- | wizards/source/sfdocuments/dialog.xlb | 3 | ||||
| -rw-r--r-- | wizards/source/sfdocuments/script.xlb | 9 |
7 files changed, 4553 insertions, 0 deletions
diff --git a/wizards/source/sfdocuments/SF_Base.xba b/wizards/source/sfdocuments/SF_Base.xba new file mode 100644 index 000000000000..166b717919d3 --- /dev/null +++ b/wizards/source/sfdocuments/SF_Base.xba @@ -0,0 +1,464 @@ +<?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_Base" 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_Base +''' ======= +''' +''' The SFDocuments library gathers a number of methods and properties making easy +''' the management and several manipulations of LibreOffice documents +''' +''' Some methods are generic for all types of documents: they are combined in the SF_Document module. +''' Specific properties and methods are implemented in the concerned subclass(es) SF_Calc, SF_Writer, ... +''' +''' 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. +''' They should also duplicate some generic private members as a subset of their own set of members +''' +''' The SF_Base module is provided only to block parent properties that are NOT applicable to Base documents +''' +''' The current module is closely related to the "UI" service 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.CreateBaseDocument("C:\Me\MyFile.odb", ...) +''' ' or Set oDoc = ui.OpenDocument("C:\Me\MyFile.odb") +''' 2) Directly if the document is already opened +''' Dim oDoc As Object +''' Set oDoc = CreateScriptService("SFDocuments.Base", "MyFile.odb") +''' ' The substring "SFDocuments." in the service name is optional +''' +''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' + +REM ================================================================== EXCEPTIONS + +Private Const DBCONNECTERROR = "DBCONNECTERROR" + +REM ============================================================= PRIVATE MEMBERS + +Private [Me] As Object +Private [_Parent] As Object +Private [_Super] As Object ' Document superclass, which the current instance is a subclass of +Private ObjectType As String ' Must be BASE +Private ServiceName As String + +' Window component +Private _Component As Object ' com.sun.star.comp.dba.ODatabaseDocument +Private _DataSource As Object ' com.sun.star.comp.dba.ODatabaseSource +Private _Database As Object ' SFDatabases.Database service instance + +REM ============================================================ MODULE CONSTANTS + +REM ===================================================== CONSTRUCTOR/DESCTRUCTOR + +REM ----------------------------------------------------------------------------- +Private Sub Class_Initialize() + Set [Me] = Nothing + Set [_Parent] = Nothing + Set [_Super] = Nothing + ObjectType = "BASE" + ServiceName = "SFDocuments.Base" + Set _Component = Nothing + Set _DataSource = Nothing + Set _Database = Nothing +End Sub ' SFDocuments.SF_Base Constructor + +REM ----------------------------------------------------------------------------- +Private Sub Class_Terminate() + Call Class_Initialize() +End Sub ' SFDocuments.SF_Base Destructor + +REM ----------------------------------------------------------------------------- +Public Function Dispose() As Variant + If Not IsNull([_Super]) Then Set [_Super] = [_Super].Dispose() + Call Class_Terminate() + Set Dispose = Nothing +End Function ' SFDocuments.SF_Base Explicit Destructor + +REM ================================================================== PROPERTIES + +REM ===================================================================== METHODS + +REM ----------------------------------------------------------------------------- +Public Function CloseDocument(Optional ByVal SaveAsk As Variant) As Boolean +''' The closure of a Base document requires the closures of +''' 1) the connection => done in the CloseDatabase() method +''' 2) the data source +''' 3) the document itself => done in the superclass + +Const cstThisSub = "SFDocuments.Base.CloseDocument" +Const cstSubArgs = "[SaveAsk=True]" + + If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch + +Check: + If IsMissing(SaveAsk) Or IsEmpty(SaveAsk) Then SaveAsk = True + If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then + If Not [_Super]._IsStillAlive(True) Then GoTo Finally + If Not ScriptForge.SF_Utils._Validate(SaveAsk, "SaveAsk", V_BOOLEAN) Then GoTo Finally + End If + +Try: + If Not IsNull(_Database) Then _Database.CloseDatabase() + If Not IsNull(_DataSource) Then _DataSource.dispose() + CloseDocument = [_Super].CloseDocument(SaveAsk) + +Finally: + ScriptForge.SF_Utils._ExitFunction(cstThisSub) + Exit Function +Catch: + GoTo Finally +End Function ' SFDocuments.SF_Base.CloseDocument + +REM ----------------------------------------------------------------------------- +Public Function GetDatabase(Optional ByVal User As Variant _ + , Optional ByVal Password As Variant _ + ) As Object +''' Returns a Database instance (service = SFDatabases.Database) giving access +''' to the execution of SQL commands on the database defined and/or stored in +''' the actual Base document +''' Args: +''' User, Password: the login parameters as strings. Defaults = "" +''' Returns: +''' A SFDatabases.Database instance or Nothing +''' Example: +''' Dim myDb As Object +''' Set myDb = oDoc.GetDatabase() + +Const cstThisSub = "SFDocuments.Base.GetDatabase" +Const cstSubArgs = "[User=""""], [Password=""""]" + + If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch + Set GetDatabase = Nothing + +Check: + If IsMissing(User) Or IsEmpty(User) Then User = "" + If IsMissing(Password) Or IsEmpty(Password) Then Password = "" + If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then + If Not [_Super]._IsStillAlive(True) Then GoTo Finally + If Not ScriptForge.SF_Utils._Validate(User, "User", V_STRING) Then GoTo Finally + If Not ScriptForge.SF_Utils._Validate(Password, "Password", V_STRING) Then GoTo Finally + End If + +Try: + If IsNull(_Database) Then ' 1st connection from the current document instance + If IsNull(_DataSource) Then GoTo CatchConnect + Set _Database = ScriptForge.SF_Services.CreateScriptService("SFDatabases.DatabaseFromDocument" _ + , _DataSource, User, Password) + If IsNull(_Database) Then GoTo CatchConnect + _Database._Location = [_Super]._WindowFileName + EndIf + +Finally: + Set GetDatabase = _Database + ScriptForge.SF_Utils._ExitFunction(cstThisSub) + Exit Function +Catch: + GoTo Finally +CatchConnect: + ScriptForge.SF_Exception.RaiseFatal(DBCONNECTERROR, "User", User, "Password", Password, [_Super]._FileIdent()) + GoTo Finally +End Function ' SFDocuments.SF_Base.GetDatabase + +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 +''' Exceptions: +''' ARGUMENTERROR The property does not exist + +Const cstThisSub = "SFDocuments.Base.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: + ' Superclass or subclass property ? + If ScriptForge.SF_Array.Contains([_Super].Properties(), PropertyName) Then + GetProperty = [_Super].GetProperty(PropertyName) + Else + GetProperty = _PropertyGet(PropertyName) + End If + +Finally: + ScriptForge.SF_Utils._ExitFunction(cstThisSub) + Exit Function +Catch: + GoTo Finally +End Function ' SFDocuments.SF_Base.GetProperty + +REM ----------------------------------------------------------------------------- +Public Function Methods() As Variant +''' Return the list of public methods of the Model service as an array + + Methods = Array( _ + "Activate" _ + , "CloseDocument" _ + , "GetDatabase" _ + , "RunCommand" _ + , "Save" _ + , "SaveAs" _ + , "SaveCopyAs" _ + ) + +End Function ' SFDocuments.SF_Base.Methods + +REM ----------------------------------------------------------------------------- +Public Function Properties() As Variant +''' Return the list or properties of the Timer class as an array + + Properties = Array( _ + "DocumentType" _ + , "IsBase" _ + , "IsCalc" _ + , "IsDraw " _ + , "IsImpress" _ + , "IsMath" _ + , "IsWriter" _ + , "XComponent" _ + ) + +End Function ' SFDocuments.SF_Base.Properties + +REM ----------------------------------------------------------------------------- +Public Function SetProperty(Optional ByVal PropertyName As Variant _ + , Optional ByRef Value As Variant _ + ) As Boolean +''' Set a new value to the given property +''' Args: +''' PropertyName: the name of the property as a string +''' Value: its new value +''' Exceptions +''' ARGUMENTERROR The property does not exist + +Const cstThisSub = "SFDocuments.Base.SetProperty" +Const cstSubArgs = "PropertyName, Value" + + If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch + SetProperty = False + +Check: + If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then + If Not SF_Utils._Validate(PropertyName, "PropertyName", V_STRING, Properties()) Then GoTo Catch + End If + +Try: + Select Case UCase(PropertyName) + Case Else + End Select + +Finally: + SF_Utils._ExitFunction(cstThisSub) + Exit Function +Catch: + GoTo Finally +End Function ' SFDocuments.SF_Documents.SetProperty + +REM ======================================================= SUPERCLASS PROPERTIES + +REM ----------------------------------------------------------------------------- +'Property Get CustomProperties() As Variant +' CustomProperties = [_Super].GetProperty("CustomProperties") +'End Property ' SFDocuments.SF_Base.CustomProperties + +REM ----------------------------------------------------------------------------- +'Property Let CustomProperties(Optional ByVal pvCustomProperties As Variant) +' [_Super].CustomProperties = pvCustomProperties +'End Property ' SFDocuments.SF_Base.CustomProperties + +REM ----------------------------------------------------------------------------- +'Property Get Description() As Variant +' Description = [_Super].GetProperty("Description") +'End Property ' SFDocuments.SF_Base.Description + +REM ----------------------------------------------------------------------------- +'Property Let Description(Optional ByVal pvDescription As Variant) +' [_Super].Description = pvDescription +'End Property ' SFDocuments.SF_Base.Description + +REM ----------------------------------------------------------------------------- +'Property Get DocumentProperties() As Variant +' DocumentProperties = [_Super].GetProperty("DocumentProperties") +'End Property ' SFDocuments.SF_Base.DocumentProperties + +REM ----------------------------------------------------------------------------- +Property Get DocumentType() As String + DocumentType = [_Super].GetProperty("DocumentType") +End Property ' SFDocuments.SF_Base.DocumentType + +REM ----------------------------------------------------------------------------- +Property Get IsBase() As Boolean + IsBase = [_Super].GetProperty("IsBase") +End Property ' SFDocuments.SF_Base.IsBase + +REM ----------------------------------------------------------------------------- +Property Get IsCalc() As Boolean + IsCalc = [_Super].GetProperty("IsCalc") +End Property ' SFDocuments.SF_Base.IsCalc + +REM ----------------------------------------------------------------------------- +Property Get IsDraw() As Boolean + IsDraw = [_Super].GetProperty("IsDraw") +End Property ' SFDocuments.SF_Base.IsDraw + +REM ----------------------------------------------------------------------------- +Property Get IsImpress() As Boolean + IsImpress = [_Super].GetProperty("IsImpress") +End Property ' SFDocuments.SF_Base.IsImpress + +REM ----------------------------------------------------------------------------- +Property Get IsMath() As Boolean + IsMath = [_Super].GetProperty("IsMath") +End Property ' SFDocuments.SF_Base.IsMath + +REM ----------------------------------------------------------------------------- +Property Get IsWriter() As Boolean + IsWriter = [_Super].GetProperty("IsWriter") +End Property ' SFDocuments.SF_Base.IsWriter + +REM ----------------------------------------------------------------------------- +'Property Get Keywords() As Variant +' Keywords = [_Super].GetProperty("Keywords") +'End Property ' SFDocuments.SF_Base.Keywords + +REM ----------------------------------------------------------------------------- +'Property Let Keywords(Optional ByVal pvKeywords As Variant) +' [_Super].Keywords = pvKeywords +'End Property ' SFDocuments.SF_Base.Keywords + +REM ----------------------------------------------------------------------------- +'Property Get Readonly() As Variant +' Readonly = [_Super].GetProperty("Readonly") +'End Property ' SFDocuments.SF_Base.Readonly + +REM ----------------------------------------------------------------------------- +'Property Get Subject() As Variant +' Subject = [_Super].GetProperty("Subject") +'End Property ' SFDocuments.SF_Base.Subject + +REM ----------------------------------------------------------------------------- +'Property Let Subject(Optional ByVal pvSubject As Variant) +' [_Super].Subject = pvSubject +'End Property ' SFDocuments.SF_Base.Subject + +REM ----------------------------------------------------------------------------- +'Property Get Title() As Variant +' Title = [_Super].GetProperty("Title") +'End Property ' SFDocuments.SF_Base.Title + +REM ----------------------------------------------------------------------------- +'Property Let Title(Optional ByVal pvTitle As Variant) +' [_Super].Title = pvTitle +'End Property ' SFDocuments.SF_Base.Title + +REM ----------------------------------------------------------------------------- +Property Get XComponent() As Variant + XComponent = [_Super].GetProperty("XComponent") +End Property ' SFDocuments.SF_Base.XComponent + +REM ========================================================== SUPERCLASS METHODS + +REM ----------------------------------------------------------------------------- +Public Function Activate() As Boolean + Activate = [_Super].Activate() +End Function ' SFDocuments.SF_Base.Activate + +REM ----------------------------------------------------------------------------- +Public Sub RunCommand(Optional ByVal Command As Variant) + [_Super].RunCommand(Command) +End Sub ' SFDocuments.SF_Base.RunCommand + +REM ----------------------------------------------------------------------------- +Public Function Save() As Boolean + Save = [_Super].Save() +End Function ' SFDocuments.SF_Base.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 + SaveAs = [_Super].SaveAs(FileName, Overwrite, Password, FilterName, FilterOptions) +End Function ' SFDocuments.SF_Base.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 + SaveCopyAs = [_Super].SaveCopyAs(FileName, Overwrite, Password, FilterName, FilterOptions) +End Function ' SFDocuments.SF_Base.SaveCopyAs + +REM =========================================================== PRIVATE FUNCTIONS + +REM ----------------------------------------------------------------------------- +Private Function _PropertyGet(Optional ByVal psProperty As String _ + , Optional ByVal pvArg As Variant _ + ) 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 vLastCell As Variant ' Coordinates of last used cell in a sheet +Dim oSelect As Object ' Current selection +Dim vRanges As Variant ' List of selected ranges +Dim i As Long +Dim cstThisSub As String +Const cstSubArgs = "" + + _PropertyGet = False + + cstThisSub = "SFDocuments.SF_Base.get" & psProperty + ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) + If Not [_Super]._IsStillAlive() Then GoTo Finally + + Select Case psProperty + Case Else + _PropertyGet = Null + End Select + +Finally: + ScriptForge.SF_Utils._ExitFunction(cstThisSub) + Exit Function +End Function ' SFDocuments.SF_Base._PropertyGet + +REM ----------------------------------------------------------------------------- +Private Function _Repr() As String +''' Convert the SF_Base instance to a readable string, typically for debugging purposes (DebugPrint ...) +''' Args: +''' Return: +''' "[Base]: Type/File" + + _Repr = "[Base]: " & [_Super]._FileIdent() + +End Function ' SFDocuments.SF_Base._Repr + +REM ============================================ END OF SFDOCUMENTS.SF_BASE +</script:module>
\ No newline at end of file diff --git a/wizards/source/sfdocuments/SF_Calc.xba b/wizards/source/sfdocuments/SF_Calc.xba new file mode 100644 index 000000000000..5c897e2dbd14 --- /dev/null +++ b/wizards/source/sfdocuments/SF_Calc.xba @@ -0,0 +1,2843 @@ +<?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_Calc" 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_Calc +''' ======= +''' +''' The SFDocuments library gathers a number of methods and properties making easy +''' the management and several manipulations of LibreOffice documents +''' +''' Some methods are generic for all types of documents: they are combined in the SF_Document module. +''' Specific properties and methods are implemented in the concerned subclass(es) SF_Calc, SF_Writer, ... +''' +''' 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. +''' They should also duplicate some generic private members as a subset of their own set of members +''' +''' The SF_Calc module is focused on : +''' - management (copy, insert, move, ...) of sheets within a Calc document +''' - exchange of data between Basic data structures and Calc ranges of values +''' +''' The current module is closely related to the "UI" service 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.CreateDocument("Calc", ...) +''' ' or Set oDoc = ui.OpenDocument("C:\Me\MyFile.ods") +''' 2) Directly if the document is already opened +''' Dim oDoc As Object +''' Set oDoc = CreateScriptService("SFDocuments.Calc", "Untitled 1") ' Default = ActiveWindow +''' ' or Set oDoc = CreateScriptService("SFDocuments.Calc", "Untitled 1") ' Untitled 1 is presumed a Calc document +''' ' The substring "SFDocuments." in the service name is optional +''' +''' Definitions: +''' Many methods require a "Sheet" or a "Range" as argument. (NB: a single cell is considered as a special case of a Range) +''' Usually, within a specific Calc instance, sheets and ranges are given as a string: "SheetX" and "D2:F6" +''' Multiple ranges are not supported in this context. +''' Additionally, the .Sheet and .Range methods return a reference that may be used +''' as argument of a method called from another instance of the Calc service +''' Example: +''' Dim oDocA As Object : Set oDocA = ui.OpenDocument("C:\FileA.ods", Hidden := True, ReadOnly := True) +''' Dim oDocB As Object : Set oDocB = ui.OpenDocument("C:\FileB.ods") +''' oDocB.CopyToRange(oDocA.Range("SheetX.D4:F8"), "D2:F6") ' CopyToRange(source, target) +''' +''' Sheet: the sheet name as a string or an object produced by .Sheet() +''' "~" = current sheet +''' Range: a string designating a set of contiguous cells located in a sheet of the current instance +''' "~" = current selection (if multiple selections, its 1st component) +''' or an object produced by .Range() +''' The sheet name is optional (default = active sheet). Surrounding quotes and $ signs are optional +''' ~.~, ~ The current selection in the active sheet +''' '$SheetX'.D2 or $D$2 A single cell +''' '$SheetX'.D2:F6, D2:D10 Multiple cells +''' '$SheetX'.A:A or 3:5 All cells in the same column or row up to the last active cell +''' SheetX.* All cells up to the last active cell +''' myRange A range name at spreadsheet level +''' ~.yourRange, SheetX.someRange A range name at sheet level +''' myDoc.Range("SheetX.D2:F6") +''' A range within the sheet SheetX in file associated with the myDoc Calc instance +''' +''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' + +REM ================================================================== EXCEPTIONS + +Private Const UNKNOWNFILEERROR = "UNKNOWNFILEERROR" +Private Const BASEDOCUMENTOPENERROR = "BASEDOCUMENTOPENERROR" +Private Const CALCADDRESSERROR = "CALCADDRESSERROR" +Private Const DUPLICATESHEETERROR = "DUPLICATESHEETERROR" +Private Const OFFSETADDRESSERROR = "OFFSETADDRESSERROR" + +REM ============================================================= PRIVATE MEMBERS + +Private [Me] As Object +Private [_Parent] As Object +Private [_Super] As Object ' Document superclass, which the current instance is a subclass of +Private ObjectType As String ' Must be CALC +Private ServiceName As String + +' Window component +Private _Component As Object ' com.sun.star.lang.XComponent + +Type _Address + ObjectType As String ' Must be "SF_CalcReference" + RawAddress As String + Component As Object ' com.sun.star.lang.XComponent + SheetName As String + SheetIndex As Integer + RangeName As String + Height As Long + Width As Long + XSpreadSheet As Object ' com.sun.star.sheet.XSpreadsheet + XCellRange As Object ' com.sun.star.table.XCellRange +End Type + +REM ============================================================ MODULE CONSTANTS + +Private Const cstSHEET = 1 +Private Const cstRANGE = 2 + +Private Const MAXCOLS = 2^10 ' Max number of colums in a sheet +Private Const MAXROWS = 2^20 ' Max number of rows in a sheet + +Private Const CALCREFERENCE = "SF_CalcReference" ' Object type of _Address + +REM ===================================================== CONSTRUCTOR/DESCTRUCTOR + +REM ----------------------------------------------------------------------------- +Private Sub Class_Initialize() + Set [Me] = Nothing + Set [_Parent] = Nothing + Set [_Super] = Nothing + ObjectType = "CALC" + ServiceName = "SFDocuments.Calc" + Set _Component = Nothing +End Sub ' SFDocuments.SF_Calc Constructor + +REM ----------------------------------------------------------------------------- +Private Sub Class_Terminate() + Call Class_Initialize() +End Sub ' SFDocuments.SF_Calc Destructor + +REM ----------------------------------------------------------------------------- +Public Function Dispose() As Variant + If Not IsNull([_Super]) Then Set [_Super] = [_Super].Dispose() + Call Class_Terminate() + Set Dispose = Nothing +End Function ' SFDocuments.SF_Calc Explicit Destructor + +REM ================================================================== PROPERTIES + +REM ----------------------------------------------------------------------------- +Property Get CurrentSelection() As Variant +''' Returns as a string the currently selected range or as an array the list of the currently selected ranges + CurrentSelection = _PropertyGet("CurrentSelection") +End Property ' SFDocuments.SF_Calc.CurrentSelection (get) + +REM ----------------------------------------------------------------------------- +Property Let CurrentSelection(Optional ByVal pvSelection As Variant) +''' Set the selection to a single or a multiple range +''' The argument is a string or an array of strings + +Dim sRange As String ' A single selection +Dim oCellRanges As Object ' com.sun.star.sheet.SheetCellRanges +Dim vRangeAddresses As Variant ' Array of com.sun.star.table.CellRangeAddress +Dim i As Long +Const cstThisSub = "SFDocuments.Calc.setCurrentSelection" +Const cstSubArgs = "Selection" + + On Local Error GoTo Catch + +Check: + If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then + If Not [_Super]._IsStillAlive(True) Then GoTo Finally + If IsArray(pvSelection) Then + If Not ScriptForge.SF_Utils._ValidateArray(pvSelection, "pvSelection", 1, V_STRING, True) Then GoTo Finally + Else + If Not ScriptForge.SF_Utils._Validate(pvSelection, "pvSelection", V_STRING) Then GoTo Finally + End If + End If + +Try: + If IsArray(pvSelection) Then + Set oCellRanges = _Component.createInstance("com.sun.star.sheet.SheetCellRanges") + vRangeAddresses = Array() + ReDim vRangeAddresses(0 To UBound(pvSelection)) + For i = 0 To UBound(pvSelection) + vRangeAddresses(i) = Range(pvSelection(i)).XCellRange.RangeAddress + Next i + oCellRanges.addRangeAddresses(vRangeAddresses, False) + _Component.CurrentController.select(oCellRanges) + Else + _Component.CurrentController.select(_ParseAddress(pvSelection).XCellRange) + End If + +Finally: + ScriptForge.SF_Utils._ExitFunction(cstThisSub) + Exit Property +Catch: + GoTo Finally +End Property ' SFDocuments.SF_Calc.CurrentSelection (let) + +REM ----------------------------------------------------------------------------- +Property Get Height(Optional ByVal RangeName As Variant) As Long +''' Returns the height in # of rows of the given range + Height = _PropertyGet("Height", RangeName) +End Property ' SFDocuments.SF_Calc.Height + +REM ----------------------------------------------------------------------------- +Property Get LastCell(Optional ByVal SheetName As Variant) As String +''' Returns the last used cell in a given sheet + LastCell = _PropertyGet("LastCell", SheetName) +End Property ' SFDocuments.SF_Calc.LastCell + +REM ----------------------------------------------------------------------------- +Property Get LastColumn(Optional ByVal SheetName As Variant) As Long +''' Returns the last used column in a given sheet + LastColumn = _PropertyGet("LastColumn", SheetName) +End Property ' SFDocuments.SF_Calc.LastColumn + +REM ----------------------------------------------------------------------------- +Property Get LastRow(Optional ByVal SheetName As Variant) As Long +''' Returns the last used column in a given sheet + LastRow = _PropertyGet("LastRow", SheetName) +End Property ' SFDocuments.SF_Calc.LastRow + +REM ----------------------------------------------------------------------------- +Property Get Range(Optional ByVal RangeName As Variant) As Variant +''' Returns a (internal) range object + Range = _PropertyGet("Range", RangeName) +End Property ' SFDocuments.SF_Calc.Range + +REM ----------------------------------------------------------------------------- +Property Get Sheet(Optional ByVal SheetName As Variant) As Variant +''' Returns a (internal) sheet object + Sheet = _PropertyGet("Sheet", SheetName) +End Property ' SFDocuments.SF_Calc.Sheet + +REM ----------------------------------------------------------------------------- +Property Get Sheets() As Variant +''' Returns an array listing the existing sheet names + Sheets = _PropertyGet("Sheets") +End Property ' SFDocuments.SF_Calc.Sheets + +REM ----------------------------------------------------------------------------- +Property Get Width(Optional ByVal RangeName As Variant) As Long +''' Returns the width in # of columns of the given range + Width = _PropertyGet("Width", RangeName) +End Property ' SFDocuments.SF_Calc.Width + +REM ----------------------------------------------------------------------------- +Property Get XCellRange(Optional ByVal RangeName As Variant) As Variant +''' Returns a UNO object of type com.sun.star.Table.CellRange + XCellRange = _PropertyGet("XCellRange", RangeName) +End Property ' SFDocuments.SF_Calc.XCellRange + +REM ----------------------------------------------------------------------------- +Property Get XSpreadsheet(Optional ByVal SheetName As Variant) As Variant +''' Returns a UNO object of type com.sun.star.sheet.XSpreadsheet + XSpreadsheet = _PropertyGet("XSpreadsheet", SheetName) +End Property ' SFDocuments.SF_Calc.XSpreadsheet + +REM ===================================================================== METHODS + +REM ----------------------------------------------------------------------------- +Public Function Activate(Optional ByVal SheetName As Variant) As Boolean +''' Make the current document or the given sheet active +''' Args: +''' SheetName: Default = the Calc document as a whole +''' Returns: +''' True if the document or the sheet could be made active +''' Otherwise, there is no change in the actual user interface +''' Examples: +''' oDoc.Activate("SheetX") + +Dim bActive As Boolean ' Return value +Dim oSheet As Object ' Reference to sheet +Const cstThisSub = "SFDocuments.Calc.Activate" +Const cstSubArgs = "[SheetName]" + + If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch + bActive = False + +Check: + If IsMissing(SheetName) Or IsEmpty(SheetName) Then SheetName = "" + If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then + If Not [_Super]._IsStillAlive() Then GoTo Finally + If Not _ValidateSheet(SheetName, "SheetName", , , True) Then GoTo Finally + End If + +Try: + ' Sheet activation, to do only when meaningful, precedes document activation + If Len(SheetName) > 0 Then + With _Component + Set oSheet = .getSheets.getByName(SheetName) + Set .CurrentController.ActiveSheet = oSheet + End With + End If + bActive = [_Super].Activate() + +Finally: + Activate = bActive + ScriptForge.SF_Utils._ExitFunction(cstThisSub) + Exit Function +Catch: + GoTo Finally +End Function ' SFDocuments.SF_Calc.Activate + +REM ----------------------------------------------------------------------------- +Public Sub ClearAll(Optional ByVal Range As Variant) As String +''' Clear entirely the given range +''' Args: +''' Range : the cell or the range as a string that should be cleared +''' Examples: +''' oDoc.ClearAll("SheetX") ' Clears the used area of the sheet + +Dim lClear As Long ' The elements to clear +Dim oRange As Object ' Alias of Range +Const cstThisSub = "SFDocuments.Calc.ClearAll" +Const cstSubArgs = "Range" + + If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch + +Check: + If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then + If Not [_Super]._IsStillAlive() Then GoTo Finally + If Not ScriptForge.SF_Utils._Validate(Range, "Range", V_STRING) Then GoTo Finally + End If + +Try: + With com.sun.star.sheet.CellFlags + lClear = 0 _ + + .VALUE _ + + .DATETIME _ + + .STRING _ + + .ANNOTATION _ + + .FORMULA _ + + .HARDATTR _ + + .STYLES _ + + .OBJECTS _ + + .EDITATTR _ + + .FORMATTED + Set oRange = _ParseAddress(Range) + oRange.XCellRange.clearContents(lClear) + End With + +Finally: + ScriptForge.SF_Utils._ExitFunction(cstThisSub) + Exit Sub +Catch: + GoTo Finally +End Sub ' SF_Documents.SF_Calc.ClearAll + +REM ----------------------------------------------------------------------------- +Public Sub ClearFormats(Optional ByVal Range As Variant) As String +''' Clear all the formatting elements of the given range +''' Args: +''' Range : the cell or the range as a string that should be cleared +''' Examples: +''' oDoc.ClearFormats("SheetX:A1:E100") ' Clear the formats of the given range + +Dim lClear As Long ' The elements to clear +Dim oRange As Object ' Alias of Range +Const cstThisSub = "SFDocuments.Calc.ClearFormats" +Const cstSubArgs = "Range" + + If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch + +Check: + If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then + If Not [_Super]._IsStillAlive() Then GoTo Finally + If Not ScriptForge.SF_Utils._Validate(Range, "Range", V_STRING) Then GoTo Finally + End If + +Try: + With com.sun.star.sheet.CellFlags + lClear = 0 _ + + .HARDATTR _ + + .STYLES _ + + .EDITATTR _ + + .FORMATTED + Set oRange = _ParseAddress(Range) + oRange.XCellRange.clearContents(lClear) + End With + +Finally: + ScriptForge.SF_Utils._ExitFunction(cstThisSub) + Exit Sub +Catch: + GoTo Finally +End Sub ' SF_Documents.SF_Calc.ClearFormats + +REM ----------------------------------------------------------------------------- +Public Sub ClearValues(Optional ByVal Range As Variant) As String +''' Clear values and formulas in the given range +''' Args: +''' Range : the cell or the range as a string that should be cleared +''' Examples: +''' oDoc.ClearValues("SheetX:*") ' Clears the used area of the sheet + +Dim lClear As Long ' The elements to clear +Dim oRange As Object ' Alias of Range +Const cstThisSub = "SFDocuments.Calc.ClearValues" +Const cstSubArgs = "Range" + + If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch + +Check: + If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then + If Not [_Super]._IsStillAlive() Then GoTo Finally + If Not ScriptForge.SF_Utils._Validate(Range, "Range", V_STRING) Then GoTo Finally + End If + +Try: + With com.sun.star.sheet.CellFlags + lClear = 0 _ + + .VALUE _ + + .DATETIME _ + + .STRING _ + + .FORMULA + Set oRange = _ParseAddress(Range) + oRange.XCellRange.clearContents(lClear) + End With + +Finally: + ScriptForge.SF_Utils._ExitFunction(cstThisSub) + Exit Sub +Catch: + GoTo Finally +End Sub ' SF_Documents.SF_Calc.ClearValues + +REM ----------------------------------------------------------------------------- +Public Function CopySheet(Optional ByVal SheetName As Variant _ + , Optional ByVal NewName As Variant _ + , Optional ByVal BeforeSheet As Variant _ + ) As Boolean +''' Copy a specified sheet before an existing sheet or at the end of the list of sheets +''' The sheet to copy may be inside any open Calc document +''' Args: +''' SheetName: The name of the sheet to copy or its reference +''' NewName: Must not exist +''' BeforeSheet: The name (string) or index (numeric, starting from 1) of the sheet before which to insert +''' Returns: +''' True if the sheet could be copied successfully +''' Exceptions: +''' DUPLICATESHEETERROR A sheet with the given name exists already +''' Examples: +''' oDoc.CopySheet("SheetX", "SheetY") +''' ' Copy within the same document +''' Dim oDocA As Object : Set oDocA = ui.OpenDocument("C:\Temp\FileA.ods", Hidden := True, ReadOnly := True) +''' Dim oDocB As Object : Set oDocB = ui.OpenDocument("C:\Temp\FileB.ods") +''' oDocB.CopySheet(oDocA.Sheet("SheetX"), "SheetY") +''' ' Copy from 1 file to another and put the new sheet at the end + +Dim bCopy As Boolean ' Return value +Dim oSheets As Object ' com.sun.star.sheet.XSpreadsheets +Dim vSheets As Variant ' List of existing sheets +Dim lSheetIndex As Long ' Index of a sheet +Dim oSheet As Object ' Alias of SheetName as reference +Dim lRandom As Long ' Output of random number generator +Dim sRandom ' Random sheet name +Const cstThisSub = "SFDocuments.Calc.CopySheet" +Const cstSubArgs = "SheetName, NewName, [BeforeSheet=""""]" + + If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch + bCopy = False + +Check: + If IsMissing(BeforeSheet) Or IsEmpty(BeforeSheet) Then BeforeSheet = 32768 + If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then + If Not [_Super]._IsStillAlive(True) Then GoTo Finally + If Not _ValidateSheet(SheetName, "SheetName", , True, , , True) Then GoTo Finally + If Not _ValidateSheet(NewName, "NewName", True) Then GoTo Finally + If Not _ValidateSheet(BeforeSheet, "BeforeSheet", , True, , True) Then GoTo Finally + End If + +Try: + ' Determine the index of the sheet before which to insert the copy + Set oSheets = _Component.getSheets + vSheets = oSheets.getElementNames() + If VarType(BeforeSheet) = V_STRING Then + lSheetIndex = ScriptForge.SF_Array.IndexOf(vSheets, BeforeSheet) + Else + lSheetIndex = BeforeSheet - 1 + If lSheetIndex < 0 Then lSheetIndex = 0 + If lSheetIndex > UBound(vSheets) Then lSheetIndex = UBound(vSheets) + 1 + End If + + ' Copy sheet inside the same document OR import from another document + If VarType(SheetName) = V_STRING Then + _Component.getSheets.copyByName(SheetName, NewName, lSheetIndex) + Else + Set oSheet = SheetName + With oSheet + ' If a sheet with same name as input exists in the target sheet, rename it first with a random name + sRandom = "" + If ScriptForge.SF_Array.Contains(vSheets, .SheetName) Then + lRandom = ScriptForge.SF_Session.ExecuteCalcFunction("RANDBETWEEN", 1, 9999999) + sRandom = "SF_" & Right("0000000" & lRandom, 7) + oSheets.getByName(.SheetName).setName(sRandom) + End If + ' Import i.o. Copy + oSheets.importSheet(oSheet.Component, .SheetName, lSheetIndex) + ' Rename to new sheet name + oSheets.getByName(.SheetName).setName(NewName) + ' Reset random name + If Len(sRandom) > 0 Then oSheets.getByName(srandom).setName(.SheetName) + End With + End If + bCopy = True + +Finally: + CopySheet = bCopy + ScriptForge.SF_Utils._ExitFunction(cstThisSub) + Exit Function +Catch: + GoTo Finally +CatchDuplicate: + ScriptForge.SF_Exception.RaiseFatal(DUPLICATESHEETERROR, "NewName", NewName, "Document", [_Super]._FileIdent()) + GoTo Finally +End Function ' SFDocuments.SF_Calc.CopySheet + +REM ----------------------------------------------------------------------------- +Public Function CopySheetFromFile(Optional ByVal FileName As Variant _ + , Optional ByVal SheetName As Variant _ + , Optional ByVal NewName As Variant _ + , Optional ByVal BeforeSheet As Variant _ + ) As Boolean +''' Copy a specified sheet before an existing sheet or at the end of the list of sheets +''' The sheet to copy is located inside any closed Calc document +''' Args: +''' FileName: Identifies the file to open. It must follow the SF_FileSystem.FileNaming notation +''' The file must not be protected with a password +''' SheetName: The name of the sheet to copy or its reference +''' NewName: Must not exist +''' BeforeSheet: The name (string) or index (numeric, starting from 1) of the sheet before which to insert +''' Returns: +''' True if the sheet could be created +''' The created sheet is blank when the input file is not a Calc file +''' The created sheet contains an error message when the input sheet was not found +''' Exceptions: +''' DUPLICATESHEETERROR A sheet with the given name exists already +''' UNKNOWNFILEERROR The input file is unknown +''' Examples: +''' oDoc.CopySheetFromFile("C:\MyFile.ods", "SheetX", "SheetY", 3) + +Dim bCopy As Boolean ' Return value +Dim oSheet As Object ' com.sun.star.sheet.XSpreadsheet +Dim sFileName As String ' URL alias of FileName +Dim FSO As Object ' SF_FileSystem +Const cstThisSub = "SFDocuments.Calc.CopySheetFromFile" +Const cstSubArgs = "FileName, SheetName, NewName, [BeforeSheet=""""]" + + If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch + bCopy = False + +Check: + If IsMissing(BeforeSheet) Or IsEmpty(BeforeSheet) Then BeforeSheet = 32768 + If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then + If Not [_Super]._IsStillAlive(True) Then GoTo Finally + If Not ScriptForge.SF_Utils._ValidateFile(FileName, "FileName") Then GoTo Finally + If Not ScriptForge.SF_Utils._Validate(SheetName, "SheetName", V_STRING) Then GoTo Finally + If Not _ValidateSheet(NewName, "NewName", True) Then GoTo Finally + If Not _ValidateSheet(BeforeSheet, "BeforeSheet", , True, , True) Then GoTo Finally + End If + +Try: + Set FSO = ScriptForge.SF_FileSystem + ' Does the input file exist ? + If Not FSO.FileExists(FileName) Then GoTo CatchNotExists + sFileName = FSO._ConvertToUrl(FileName) + + ' Insert a blank new sheet and import sheet from file va link setting and deletion + If Not InsertSheet(Newname, BeforeSheet) Then GoTo Finally + Set oSheet = _Component.getSheets.getByName(NewName) + With oSheet + .link(sFileName,SheetName, "", "", com.sun.star.sheet.SheetLinkMode.NORMAL) + .LinkMode = com.sun.star.sheet.SheetLinkMode.NONE + .LinkURL = "" + End With + bCopy = True + +Finally: + CopySheetFromFile = bCopy + ScriptForge.SF_Utils._ExitFunction(cstThisSub) + Exit Function +Catch: + GoTo Finally +CatchNotExists: + ScriptForge.SF_Exception.RaiseFatal(UNKNOWNFILEERROR, "FileName", FileName) + GoTo Finally +End Function ' SFDocuments.SF_Calc.CopySheetFromFile + +REM ----------------------------------------------------------------------------- +Public Function CopyToCell(Optional ByVal SourceRange As Variant _ + , Optional ByVal DestinationCell As Variant _ + ) As String +''' Copy a specified source range to a destination range or cell +''' The source range may belong to another open document +''' The method imitates the behaviour of a Copy/Paste from a range to a single cell +''' Args: +''' SourceRange: the source range as a string if it belongs to the same document +''' or as a reference if it belongs to another open Calc document +''' DestinationCell: the destination of the copied range of cells, as a string +''' If given as range, the destination will be reduced to its top-left cell +''' Returns: +''' A string representing the modified range of cells +''' The modified area depends only on the size of the source area +''' Examples: +''' oDoc.CopyToCell("SheetX.A1:F10", "SheetY.C5") +''' ' Copy within the same document +''' Dim oDocA As Object : Set oDocA = ui.OpenDocument("C:\Temp\FileA.ods", Hidden := True, ReadOnly := True) +''' Dim oDocB As Object : Set oDocB = ui.OpenDocument("C:\Temp\FileB.ods") +''' oDocB.CopyToCell(oDocA.Range("SheetX.A1:F10"), "SheetY.C5") +''' ' Copy from 1 file to another + +Dim sCopy As String ' Return value +Dim oSource As Object ' Alias of SourceRange to avoid "Object variable not set" run-time error +Dim oSourceAddress As Object ' com.sun.star.table.CellRangeAddress +Dim oDestRange As Object ' Destination as a range +Dim oDestAddress As Object ' com.sun.star.table.CellRangeAddress +Dim oDestCell As Object ' com.sun.star.table.CellAddress +Dim oSelect As Object ' Current selection in source +Dim oClipboard As Object ' com.sun.star.datatransfer.XTransferable + +Const cstThisSub = "SFDocuments.Calc.CopyToCell" +Const cstSubArgs = "SourceRange, DestinationCell" + + If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch + sCopy = "" + +Check: + If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then + If Not [_Super]._IsStillAlive(True) Then GoTo Finally + If Not ScriptForge.SF_Utils._Validate(SourceRange, "SourceRange", Array(V_STRING, ScriptForge.V_OBJECT), , , CALCREFERENCE) Then GoTo Finally + If Not ScriptForge.SF_Utils._Validate(DestinationCell, "DestinationCell", V_STRING) Then GoTo Finally + End If + +Try: + If VarType(SourceRange) = V_STRING Then ' Same document - Use UNO copyRange method + Set oSourceAddress = _ParseAddress(SourceRange).XCellRange.RangeAddress + Set oDestRange = _ParseAddress(DestinationCell) + Set oDestAddress = oDestRange.XCellRange.RangeAddress + Set oDestCell = New com.sun.star.table.CellAddress + With oDestAddress + oDestCell.Sheet = .Sheet + oDestCell.Column = .StartColumn + oDestCell.Row = .StartRow + End With + oDestRange.XSpreadsheet.copyRange(oDestCell, oSourceAddress) + Else ' Use clipboard to copy - current selection in Source should be preserved + Set oSource = SourceRange + With oSource + ' Keep current selection in source document + Set oSelect = .Component.CurrentController.getSelection() + ' Select, copy the source range and paste in the top-left cell of the destination + .Component.CurrentController.select(.XCellRange) + Set oClipboard = .Component.CurrentController.getTransferable() + _Component.CurrentController.select(_Offset(DestinationCell, 0, 0, 1, 1).XCellRange) + _Component.CurrentController.insertTransferable(oClipBoard) + ' Restore previous selection in Source + _RestoreSelections(.Component, oSelect) + Set oSourceAddress = .XCellRange.RangeAddress + End With + End If + + With oSourceAddress + sCopy = _Offset(DestinationCell, 0, 0, .EndRow - .StartRow + 1, .EndColumn - .StartColumn + 1).RangeName + End With + +Finally: + CopyToCell = sCopy + ScriptForge.SF_Utils._ExitFunction(cstThisSub) + Exit Function +Catch: + GoTo Finally +End Function ' SFDocuments.SF_Calc.CopyToCell + +REM ----------------------------------------------------------------------------- +Public Function CopyToRange(Optional ByVal SourceRange As Variant _ + , Optional ByVal DestinationRange As Variant _ + ) As String +''' Copy downwards and/or rightwards a specified source range to a destination range +''' The source range may belong to another open document +''' The method imitates the behaviour of a Copy/Paste from a range to a larger range +''' If the height (resp. width) of the destination area is > 1 row (resp. column) +''' then the height (resp. width) of the source must be <= the height (resp. width) +''' of the destination. Otherwise nothing happens +''' If the height (resp.width) of the destination is = 1 then the destination +''' is expanded downwards (resp. rightwards) up to the height (resp. width) +''' of the source range +''' Args: +''' SourceRange: the source range as a string if it belongs to the same document +''' or as a reference if it belongs to another open Calc document +''' DestinationRange: the destination of the copied range of cells, as a string +''' Returns: +''' A string representing the modified range of cells +''' Examples: +''' oDoc.CopyToRange("SheetX.A1:F10", "SheetY.C5:J5") +''' ' Copy within the same document +''' ' Returned range: $SheetY.$C$5:$J$14 +''' Dim oDocA As Object : Set oDocA = ui.OpenDocument("C:\Temp\FileA.ods", Hidden := True, ReadOnly := True) +''' Dim oDocB As Object : Set oDocB = ui.OpenDocument("C:\Temp\FileB.ods") +''' oDocB.CopyToRange(oDocA.Range("SheetX.A1:F10"), "SheetY.C5:J5") +''' ' Copy from 1 file to another + +Dim sCopy As String ' Return value +Dim oSource As Object ' Alias of SourceRange to avoid "Object variable not set" run-time error +Dim oDestRange As Object ' Destination as a range +Dim oDestCell As Object ' com.sun.star.table.CellAddress +Dim oSelect As Object ' Current selection in source +Dim oClipboard As Object ' com.sun.star.datatransfer.XTransferable +Dim bSameDocument As Boolean ' True when source in same document as destination +Dim lHeight As Long ' Height of destination +Dim lWidth As Long ' Width of destination + +Const cstThisSub = "SFDocuments.Calc.CopyToRange" +Const cstSubArgs = "SourceRange, DestinationRange" + + If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch + sCopy = "" + +Check: + If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then + If Not [_Super]._IsStillAlive(True) Then GoTo Finally + If Not ScriptForge.SF_Utils._Validate(SourceRange, "SourceRange", Array(V_STRING, ScriptForge.V_OBJECT), , , CALCREFERENCE) Then GoTo Finally + If Not ScriptForge.SF_Utils._Validate(DestinationRange, "DestinationRange", V_STRING) Then GoTo Finally + End If + +Try: + ' Copy done via clipboard + + ' Check Height/Width destination = 1 or > Height/Width of source + bSameDocument = ( VarType(SourceRange) = V_STRING ) + If bSameDocument Then Set oSource = _ParseAddress(SourceRange) Else Set oSource = SourceRange + Set oDestRange = _ParseAddress(DestinationRange) + With oDestRange + lHeight = .Height + lWidth = .Width + If lHeight = 1 Then + lHeight = oSource.Height ' Future height + ElseIf lHeight < oSource.Height Then + GoTo Finally + End If + If lWidth = 1 Then + lWidth = oSource.Width ' Future width + ElseIf lWidth < oSource.Width Then + GoTo Finally + End If + End With + + With oSource + ' Store actual selection in source + Set oSelect = .Component.CurrentController.getSelection() + ' Select, copy the source range and paste in the destination + .Component.CurrentController.select(.XCellRange) + Set oClipboard = .Component.CurrentController.getTransferable() + _Component.CurrentController.select(oDestRange.XCellRange) + _Component.CurrentController.insertTransferable(oClipBoard) + ' Restore selection in source + _RestoreSelections(.Component, oSelect) + End With + + sCopy = _Offset(oDestRange, 0, 0, lHeight, lWidth).RangeName + +Finally: + CopyToRange = sCopy + ScriptForge.SF_Utils._ExitFunction(cstThisSub) + Exit Function +Catch: + GoTo Finally +End Function ' SFDocuments.SF_Calc.CopyToRange + +REM ----------------------------------------------------------------------------- +Public Function DAvg(Optional ByVal Range As Variant) As Double +''' Get the average of the numeric values stored in the given range +''' Args: +''' Range : the range as a string where to get the values from +''' Returns: +''' The average of the numeric values as a double +''' Examples: +''' Val = oDoc.DAvg("~.A1:A1000") + +Try: + DAvg = _DFunction("DAvg", Range) + +Finally: + Exit Function +End Function ' SF_Documents.SF_Calc.DAvg + +REM ----------------------------------------------------------------------------- +Public Function DCount(Optional ByVal Range As Variant) As Long +''' Get the number of numeric values stored in the given range +''' Args: +''' Range : the range as a string where to get the values from +''' Returns: +''' The number of numeric values a Long +''' Examples: +''' Val = oDoc.DCount("~.A1:A1000") + +Try: + DCount = _DFunction("DCount", Range) + +Finally: + Exit Function +End Function ' SF_Documents.SF_Calc.DCount + +REM ----------------------------------------------------------------------------- +Public Function DMax(Optional ByVal Range As Variant) As Double +''' Get the greatest of the numeric values stored in the given range +''' Args: +''' Range : the range as a string where to get the values from +''' Returns: +''' The greatest of the numeric values as a double +''' Examples: +''' Val = oDoc.DMax("~.A1:A1000") + +Try: + DMax = _DFunction("DMax", Range) + +Finally: + Exit Function +End Function ' SF_Documents.SF_Calc.DMax + +REM ----------------------------------------------------------------------------- +Public Function DMin(Optional ByVal Range As Variant) As Double +''' Get the smallest of the numeric values stored in the given range +''' Args: +''' Range : the range as a string where to get the values from +''' Returns: +''' The smallest of the numeric values as a double +''' Examples: +''' Val = oDoc.DMin("~.A1:A1000") + +Try: + DMin = _DFunction("DMin", Range) + +Finally: + Exit Function +End Function ' SF_Documents.SF_Calc.DMin + +REM ----------------------------------------------------------------------------- +Public Function DSum(Optional ByVal Range As Variant) As Double +''' Get sum of the numeric values stored in the given range +''' Args: +''' Range : the range as a string where to get the values from +''' Returns: +''' The sum of the numeric values as a double +''' Examples: +''' Val = oDoc.DSum("~.A1:A1000") + +Try: + DSum = _DFunction("DSum", Range) + +Finally: + Exit Function +End Function ' SF_Documents.SF_Calc.DSum + +REM ----------------------------------------------------------------------------- +Function GetColumnName(Optional ByVal ColumnNumber As Variant) As String +''' Convert a column number (range 1, 2,..1024) into its letter counterpart (range 'A', 'B',..'AMJ'). +''' Args: +''' ColumnNumber: the column number, must be in the interval 1 ... 1024 +''' Returns: +''' a string representation of the column name, in range 'A'..'AMJ' +''' If ColumnNumber is not in the allowed range, returns a zero-length string +''' Example: +''' MsgBox oDoc.GetColumnName(1022) ' "AMH" +''' Adapted from a Python function by sundar nataraj +''' http://stackoverflow.com/questions/23861680/convert-spreadsheet-number-to-column-letter + +Dim sCol As String ' Return value +Const cstThisSub = "SFDocuments.Calc.GetColumnName" +Const cstSubArgs = "ColumnNumber" + + If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch + sCol = "" + +Check: + If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then + If Not SF_Utils._Validate(ColumnNumber, "ColumnNumber", V_NUMERIC) Then GoTo Finally + End If + +Try: + If (ColumnNumber > 0) And (ColumnNumber <= MAXCOLS) Then sCol = _GetColumnName(ColumnNumber) + +Finally: + GetColumnName = sCol + ScriptForge.SF_Utils._ExitFunction(cstThisSub) + Exit Function +Catch: + GoTo Finally +End Function ' SFDocuments.SF_Calc.GetColumnName + +REM ----------------------------------------------------------------------------- +Public Function GetFormula(Optional ByVal Range As Variant) As Variant +''' Get the formula(e) stored in the given range of cells +''' Args: +''' Range : the range as a string where to get the formula from +''' Returns: +''' A scalar, a zero-based 1D array or a zero-based 2D array of strings +''' Examples: +''' Val = oDoc.GetFormula("~.A1:A1000") + +Dim vGet As Variant ' Return value +Dim oAddress As Object ' Alias of Range +Dim vDataArray As Variant ' DataArray compatible with .DataArray UNO property +Const cstThisSub = "SFDocuments.Calc.GetFormula" +Const cstSubArgs = "Range" + + If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch + vGet = Empty + +Check: + If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then + If Not [_Super]._IsStillAlive() Then GoTo Finally + If Not ScriptForge.SF_Utils._Validate(Range, "Range", V_STRING) Then GoTo Finally + End If + +Try: + ' Get the data + Set oAddress = _ParseAddress(Range) + vDataArray = oAddress.XCellRange.getFormulaArray() + + ' Convert the data array to scalar, vector or array + vGet = _ConvertFromDataArray(vDataArray) + +Finally: + GetFormula = vGet + ScriptForge.SF_Utils._ExitFunction(cstThisSub) + Exit Function +Catch: + GoTo Finally +End Function ' SF_Documents.SF_Calc.GetFormula + +REM ----------------------------------------------------------------------------- +Public Function GetProperty(Optional ByVal PropertyName As Variant _ + , Optional ObjectName As Variant _ + ) As Variant +''' Return the actual value of the given property +''' Args: +''' PropertyName: the name of the property as a string +''' ObjectName: a sheet or range name +''' Returns: +''' The actual value of the property +''' Exceptions: +''' ARGUMENTERROR The property does not exist + +Const cstThisSub = "SFDocuments.Calc.GetProperty" +Const cstSubArgs = "" + + If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch + GetProperty = Null + +Check: + If IsMissing(ObjectName) Or IsEMpty(ObjectName) Then ObjectName = "" + If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then + If Not ScriptForge.SF_Utils._Validate(PropertyName, "PropertyName", V_STRING, Properties()) Then GoTo Catch + If Not ScriptForge.SF_Utils._Validate(ObjectName, "ObjectName", V_STRING) Then GoTo Catch + End If + +Try: + ' Superclass or subclass property ? + If ScriptForge.SF_Array.Contains([_Super].Properties(), PropertyName) Then + GetProperty = [_Super].GetProperty(PropertyName) + Else + GetProperty = _PropertyGet(PropertyName) + End If + +Finally: + ScriptForge.SF_Utils._ExitFunction(cstThisSub) + Exit Function +Catch: + GoTo Finally +End Function ' SFDocuments.SF_Calc.GetProperty + +REM ----------------------------------------------------------------------------- +Public Function GetValue(Optional ByVal Range As Variant) As Variant +''' Get the value(s) stored in the given range of cells +''' Args: +''' Range : the range as a string where to get the value from +''' Returns: +''' A scalar, a zero-based 1D array or a zero-based 2D array of strings and doubles +''' To convert doubles to dates, use the CDate builtin function +''' Examples: +''' Val = oDoc.GetValue("~.A1:A1000") + +Dim vGet As Variant ' Return value +Dim oAddress As Object ' Alias of Range +Dim vDataArray As Variant ' DataArray compatible with .DataArray UNO property +Const cstThisSub = "SFDocuments.Calc.GetValue" +Const cstSubArgs = "Range" + + If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch + vGet = Empty + +Check: + If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then + If Not [_Super]._IsStillAlive() Then GoTo Finally + If Not ScriptForge.SF_Utils._Validate(Range, "Range", V_STRING) Then GoTo Finally + End If + +Try: + ' Get the data + Set oAddress = _ParseAddress(Range) + vDataArray = oAddress.XCellRange.getDataArray() + + ' Convert the data array to scalar, vector or array + vGet = _ConvertFromDataArray(vDataArray) + +Finally: + GetValue = vGet + ScriptForge.SF_Utils._ExitFunction(cstThisSub) + Exit Function +Catch: + GoTo Finally +End Function ' SF_Documents.SF_Calc.GetValue + +REM ----------------------------------------------------------------------------- +Public Function ImportFromCSVFile(Optional ByVal FileName As Variant _ + , Optional ByVal DestinationCell As Variant _ + , Optional ByVal FilterOptions As Variant _ + ) As String +''' Import the content of a CSV-formatted text file starting from a given cell +''' Beforehands the destination area will be cleared from any content and format +''' Args: +''' FileName: Identifies the file to open. It must follow the SF_FileSystem.FileNaming notation +''' DestinationCell: the destination of the copied range of cells, as a string +''' If given as range, the destination will be reduced to its top-left cell +''' FilterOptions: The arguments of the CSV input filter. +''' Read https://wiki.openoffice.org/wiki/Documentation/DevGuide/Spreadsheets/Filter_Options#Filter_Options_for_the_CSV_Filter +''' Default: input file encoding is UTF8 +''' separator = comma, semi-colon or tabulation +''' string delimiter = double quote +''' all lines are included +''' quoted strings are formatted as texts +''' special numbers are detected +''' all columns are presumed texts +''' language = english/US => decimal separator is ".", thousands separator = "," +''' Returns: +''' A string representing the modified range of cells +''' The modified area depends only on the content of the source file +''' Exceptions: +''' DOCUMENTOPENERROR The csv file could not be opened +''' Examples: +''' oDoc.ImportFromCSVFile("C:\Temp\myCsvFile.csv", "SheetY.C5") + +Dim sImport As String ' Return value +Dim oUI As Object ' UI service +Dim oSource As Object ' New Calc document with csv loaded +Dim oSelect As Object ' Current selection in destination + +Const cstFilter = "Text - txt - csv (StarCalc)" +Const cstFilterOptions = "9/44/59/MRG,34,76,1,,1033,true,true" +Const cstThisSub = "SFDocuments.Calc.ImportFromCSVFile" +Const cstSubArgs = "FileName, DestinationCell, [FilterOptions]=""9/44/59/MRG,34,76,1,,1033,true,true""" + +' If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch + sImport = "" + +Check: + If IsMissing(FilterOptions) Or IsEmpty(FilterOptions) Then FilterOptions = cstFilterOptions + If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then + If Not [_Super]._IsStillAlive(True) Then GoTo Finally + If Not ScriptForge.SF_Utils._ValidateFile(FileName, "FileName") Then GoTo Finally + If Not ScriptForge.SF_Utils._Validate(DestinationCell, "DestinationCell", V_STRING) Then GoTo Finally + End If + +Try: + ' Input file is loaded in an empty worksheet. Data are copied to destination cell + Set oUI = CreateScriptService("UI") + Set oSource = oUI.OpenDocument(FileName _ + , ReadOnly := True _ + , Hidden := True _ + , FilterName := cstFilter _ + , FilterOptions := FilterOptions _ + ) + ' Remember current selection and restore it after copy + Set oSelect = _Component.CurrentController.getSelection() + sImport = CopyToCell(oSource.Range("*"), DestinationCell) + _RestoreSelections(_Component, oSelect) + +Finally: + If Not IsNull(oSource) Then oSource.CloseDocument(False) + ImportFromCSVFile = sImport + ScriptForge.SF_Utils._ExitFunction(cstThisSub) + Exit Function +Catch: + GoTo Finally +End Function ' SFDocuments.SF_Calc.ImportFromCSVFile + +REM ----------------------------------------------------------------------------- +Public Sub ImportFromDatabase(Optional ByVal FileName As Variant _ + , Optional ByVal RegistrationName As Variant _ + , Optional ByVal DestinationCell As Variant _ + , Optional ByVal SQLCommand As Variant _ + , Optional ByVal DirectSQL As Variant _ + ) +''' Import the content of a database table, query or resultset, i.e. the result of a SELECT SQL command, +''' starting from a given cell +''' Beforehands the destination area will be cleared from any content and format +''' The modified area depends only on the content of the source data +''' Args: +''' FileName: Identifies the file to open. It must follow the SF_FileSystem.FileNaming notation +''' RegistrationName: the name of a registered database +''' It is ignored if FileName <> "" +''' DestinationCell: the destination of the copied range of cells, as a string +''' If given as range, the destination will be reduced to its top-left cell +''' SQLCommand: either a table or query name (without square brackets) +''' or a full SQL commands where table and fieldnames are preferably surrounded with square brackets +''' Returns: +''' Implemented as a Sub because the doImport UNO method does not return any error +''' Exceptions: +''' BASEDOCUMENTOPENERROR The database file could not be opened +''' Examples: +''' oDoc.ImportFromDatabase("C:\Temp\myDbFile.odb", , "SheetY.C5", "SELECT * FROM [Employees] ORDER BY [LastName]") + +Dim oDBContext As Object ' com.sun.star.sdb.DatabaseContext +Dim oDatabase As Object ' SFDatabases.Database service +Dim lCommandType As Long ' A com.sun.star.sheet.DataImportMode.xxx constant +Dim oQuery As Object ' com.sun.star.ucb.XContent +Dim bDirect As Boolean ' Alias of DirectSQL +Dim oDestRange As Object ' Destination as a range +Dim oDestAddress As Object ' com.sun.star.table.CellRangeAddress +Dim oDestCell As Object ' com.sun.star.table.XCell +Dim oSelect As Object ' Current selection in destination +Dim vImportOptions As Variant ' Array of PropertyValues + +Const cstThisSub = "SFDocuments.Calc.ImportFromDatabase" +Const cstSubArgs = "[FileName=""""], [RegistrationName=""""], DestinationCell, SQLCommand, [DirectSQL=False]" + +' If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch + +Check: + + If IsMissing(FileName) Or IsEmpty(FileName) Then FileName = "" + If IsMissing(RegistrationName) Or IsEmpty(RegistrationName) Then RegistrationName = "" + If IsMissing(DirectSQL) Or IsEmpty(DirectSQL) Then DirectSQL = False + If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then + If Not [_Super]._IsStillAlive(True) Then GoTo Finally + If Not ScriptForge.SF_Utils._ValidateFile(FileName, "FileName", , True) Then GoTo Finally + If Not ScriptForge.SF_Utils._Validate(DestinationCell, "DestinationCell", V_STRING) Then GoTo Finally + If Not ScriptForge.SF_Utils._Validate(SQLCommand, "SQLCommand", V_STRING) Then GoTo Finally + If Not ScriptForge.SF_Utils._Validate(DirectSQL, "DirectSQL", ScriptForge.V_BOOLEAN) Then GoTo Finally + End If + + ' Check the existence of FileName + If Len(FileName) = 0 Then ' FileName has precedence over RegistrationName + If Len(RegistrationName) = 0 Then GoTo CatchError + Set oDBContext = ScriptForge.SF_Utils._GetUNOService("DatabaseContext") + If Not oDBContext.hasRegisteredDatabase(RegistrationName) Then GoTo CatchError + FileName = ScriptForge.SF_FileSystem._ConvertFromUrl(oDBContext.getDatabaseLocation(RegistrationName)) + End If + If Not ScriptForge.SF_FileSystem.FileExists(FileName) Then GoTo CatchError + +Try: + ' Check command type + Set oDatabase = ScriptForge.SF_Services.CreateScriptService("SFDatabases.Database", FileName, , True) ' Read-only + If IsNull(oDatabase) Then GoTo CatchError + With oDatabase + If ScriptForge.SF_Array.Contains(.Tables, SQLCommand) Then + bDirect = True + lCommandType = com.sun.star.sheet.DataImportMode.TABLE + ElseIf ScriptForge.SF_Array.Contains(.Queries, SQLCommand) Then + Set oQuery = .XConnection.Queries.getByName(SQLCommand) + bDirect = Not oQuery.EscapeProcessing + lCommandType = com.sun.star.sheet.DataImportMode.QUERY + Else + bDirect = DirectSQL + lCommandType = com.sun.star.sheet.DataImportMode.SQL + SQLCommand = ._ReplaceSquareBrackets(SQLCommand) + End If + .CloseDatabase() + Set oDatabase = oDatabase.Dispose() + End With + + ' Determine the destination cell as the top-left coordinates of the given range + Set oDestRange = _ParseAddress(DestinationCell) + Set oDestAddress = oDestRange.XCellRange.RangeAddress + Set oDestCell = oDestRange.XSpreadsheet.getCellByPosition(oDestAddress.StartColumn, oDestAddress.StartRow) + + ' Remember current selection + Set oSelect = _Component.CurrentController.getSelection() + ' Import arguments + vImportOptions = Array(_ + ScriptForge.SF_Utils._MakePropertyValue("DatabaseName", ScriptForge.SF_FileSystem._ConvertToUrl(FileName)) _ + , ScriptForge.SF_Utils._MakePropertyValue("SourceObject", SQLCommand) _ + , ScriptForge.SF_Utils._MakePropertyValue("SourceType", lCommandType) _ + , ScriptForge.SF_Utils._MakePropertyValue("IsNative", bDirect) _ + ) + oDestCell.doImport(vImportOptions) + ' Restore selection after import_ + _RestoreSelections(_Component, oSelect) + +Finally: + ScriptForge.SF_Utils._ExitFunction(cstThisSub) + Exit Sub +Catch: + GoTo Finally +CatchError: + SF_Exception.RaiseFatal(BASEDOCUMENTOPENERROR, "FileName", FileName, "RegistrationName", RegistrationName) + GoTo Finally +End Sub ' SFDocuments.SF_Calc.ImportFromDatabase + +REM ----------------------------------------------------------------------------- +Public Function InsertSheet(Optional ByVal SheetName As Variant _ + , Optional ByVal BeforeSheet As Variant _ + ) As Boolean +''' Insert a new empty sheet before an existing sheet or at the end of the list of sheets +''' Args: +''' SheetName: The name of the new sheet +''' BeforeSheet: The name (string) or index (numeric, starting from 1) of the sheet before which to insert +''' Returns: +''' True if the sheet could be inserted successfully +''' Examples: +''' oDoc.InsertSheet("SheetX", "SheetY") + +Dim bInsert As Boolean ' Return value +Dim vSheets As Variant ' List of existing sheets +Dim lSheetIndex As Long ' Index of a sheet +Const cstThisSub = "SFDocuments.Calc.InsertSheet" +Const cstSubArgs = "SheetName, [BeforeSheet=""""]" + + If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch + bInsert = False + +Check: + If IsMissing(BeforeSheet) Or IsEmpty(BeforeSheet) Then BeforeSheet = 32768 + If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then + If Not [_Super]._IsStillAlive(True) Then GoTo Finally + If Not _ValidateSheet(SheetName, "SheetName", True) Then GoTo Finally + If Not _ValidateSheet(BeforeSheet, "BeforeSheet", , True, , True) Then GoTo Finally + End If + vSheets = _Component.getSheets.getElementNames() + +Try: + If VarType(BeforeSheet) = V_STRING Then + lSheetIndex = ScriptForge.SF_Array.IndexOf(vSheets, BeforeSheet) + Else + lSheetIndex = BeforeSheet - 1 + If lSheetIndex < 0 Then lSheetIndex = 0 + If lSheetIndex > UBound(vSheets) Then lSheetIndex = UBound(vSheets) + 1 + End If + _Component.getSheets.insertNewByName(SheetName, lSheetIndex) + bInsert = True + +Finally: + InsertSheet = binsert + ScriptForge.SF_Utils._ExitFunction(cstThisSub) + Exit Function +Catch: + GoTo Finally +End Function ' SFDocuments.SF_Calc.InsertSheet + +REM ----------------------------------------------------------------------------- +Public Function Methods() As Variant +''' Return the list of public methods of the Model service as an array + + Methods = Array( _ + "Activate" _ + , "ClearAll" _ + , "ClearFormats" _ + , "ClearValues" _ + , "CloseDocument" _ + , "CopySheet" _ + , "CopySheetFromFile" _ + , "CopyToCell" _ + , "CopyToRange" _ + , "DAvg" _ + , "DCount" _ + , "DMax" _ + , "DMin" _ + , "DSum" _ + , "GetColumnName" _ + , "GetFormula" _ + , "GetValue" _ + , "ImportFromCSVFile" _ + , "ImportFromDatabase" _ + , "InsertSheet" _ + , "MoveRange" _ + , "MoveSheet" _ + , "Offset" _ + , "RemoveSheet" _ + , "RenameSheet" _ + , "RunCommand" _ + , "Save" _ + , "SaveAs" _ + , "SaveCopyAs" _ + , "SetArray" _ + , "SetCellStyle" _ + , "SetFormula" _ + , "SetValue" _ + , "SortRange" _ + ) + +End Function ' SFDocuments.SF_Calc.Methods + +REM ----------------------------------------------------------------------------- +Public Function MoveRange(Optional ByVal Source As Variant _ + , Optional ByVal Destination As Variant _ + ) As String +''' Move a specified source range to a destination range +''' Args: +''' Source: the source range of cells as a string +''' Destination: the destination of the moved range of cells, as a string +''' Returns: +''' A string representing the modified range of cells +''' The modified area depends only on the size of the source area +''' Examples: +''' oDoc.MoveRange("SheetX.A1:F10", "SheetY.C5") + +Dim sMove As String ' Return value +Dim oSource As Object ' Alias of Source to avoid "Object variable not set" run-time error +Dim oSourceAddress As Object ' com.sun.star.table.CellRangeAddress +Dim oDestRange As Object ' Destination as a range +Dim oDestAddress As Object ' com.sun.star.table.CellRangeAddress +Dim oDestCell As Object ' com.sun.star.table.CellAddress +Dim oSelect As Object ' Current selection in source +Dim oClipboard As Object ' com.sun.star.datatransfer.XTransferable +Dim oCellRanges As Object ' com.sun.star.sheet.SheetCellRanges +Dim vRangeAddresses As Variant ' Array of com.sun.star.table.CellRangeAddress +Dim i As Long + +Const cstThisSub = "SFDocuments.Calc.MoveRange" +Const cstSubArgs = "Source, Destination" + + If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch + sMove = "" + +Check: + If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then + If Not [_Super]._IsStillAlive(True) Then GoTo Finally + If Not _Validate(Source, "Source", V_STRING) Then GoTo Finally + If Not _Validate(Destination, "Destination", V_STRING) Then GoTo Finally + End If + +Try: + Set oSourceAddress = _ParseAddress(Source).XCellRange.RangeAddress + Set oDestRange = _ParseAddress(Destination) + Set oDestAddress = oDestRange.XCellRange.RangeAddress + Set oDestCell = New com.sun.star.table.CellAddress + With oDestAddress + oDestCell.Sheet = .Sheet + oDestCell.Column = .StartColumn + oDestCell.Row = .StartRow + End With + oDestRange.XSpreadsheet.moveRange(oDestCell, oSourceAddress) + + With oSourceAddress + sMove = _Offset(Destination, 0, 0, .EndRow - .StartRow + 1, .EndColumn - .StartColumn + 1).RangeName + End With + +Finally: + MoveRange = sMove + ScriptForge.SF_Utils._ExitFunction(cstThisSub) + Exit Function +Catch: + GoTo Finally +End Function ' SFDocuments.SF_Calc.MoveRange + +REM ----------------------------------------------------------------------------- +Public Function MoveSheet(Optional ByVal SheetName As Variant _ + , Optional ByVal BeforeSheet As Variant _ + ) As Boolean +''' Move a sheet before an existing sheet or at the end of the list of sheets +''' Args: +''' SheetName: The name of the sheet to move +''' BeforeSheet: The name (string) or index (numeric, starting from 1) of the sheet before which to move the sheet +''' Returns: +''' True if the sheet could be moved successfully +''' Examples: +''' oDoc.MoveSheet("SheetX", "SheetY") + +Dim bMove As Boolean ' Return value +Dim vSheets As Variant ' List of existing sheets +Dim lSheetIndex As Long ' Index of a sheet +Const cstThisSub = "SFDocuments.Calc.MoveSheet" +Const cstSubArgs = "SheetName, [BeforeSheet=""""]" + + If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch + bMove = False + +Check: + If IsMissing(BeforeSheet) Or IsEmpty(BeforeSheet) Then BeforeSheet = 32768 + If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then + If Not [_Super]._IsStillAlive(True) Then GoTo Finally + If Not _ValidateSheet(SheetName, "SheetName", , True) Then GoTo Finally + If Not _ValidateSheet(BeforeSheet, "BeforeSheet", , True, , True) Then GoTo Finally + End If + vSheets = _Component.getSheets.getElementNames() + +Try: + If VarType(BeforeSheet) = V_STRING Then + lSheetIndex = ScriptForge.SF_Array.IndexOf(vSheets, BeforeSheet) + Else + lSheetIndex = BeforeSheet - 1 + If lSheetIndex < 0 Then lSheetIndex = 0 + If lSheetIndex > UBound(vSheets) Then lSheetIndex = UBound(vSheets) + 1 + End If + _Component.getSheets.MoveByName(SheetName, lSheetIndex) + bMove = True + +Finally: + MoveSheet = bMove + ScriptForge.SF_Utils._ExitFunction(cstThisSub) + Exit Function +Catch: + GoTo Finally +End Function ' SFDocuments.SF_Calc.MoveSheet + +REM ----------------------------------------------------------------------------- +Public Function Offset(Optional ByRef Range As Variant _ + , Optional ByVal Rows As Variant _ + , Optional ByVal Columns As Variant _ + , Optional ByVal Height As Variant _ + , Optional ByVal Width As Variant _ + ) As String +''' Returns a new range offset by a certain number of rows and columns from a given range +''' Args: +''' Range : the range, as a string, from which the function searches for the new range +''' Rows : the number of rows by which the reference was corrected up (negative value) or down. +''' Use 0 (default) to stay in the same row. +''' Columns : the number of columns by which the reference was corrected to the left (negative value) or to the right. +''' Use 0 (default) to stay in the same column +''' Height : the vertical height for an area that starts at the new reference position. +''' Default = no vertical resizing +''' Width : the horizontal width for an area that starts at the new reference position. +''' Default - no horizontal resizing +''' Arguments Rows and Columns must not lead to zero or negative start row or column. +''' Arguments Height and Width must not lead to zero or negative count of rows or columns. +''' Returns: +''' A new range as a string +''' Exceptions: +''' OFFSETADDRESSERROR The computed range of cells falls beyond the sheet boundaries +''' Examples: +''' oDoc.Offset("A1", 2, 2) ' "'SheetX'.$C$3" (A1 moved by two rows and two columns down) +''' oDoc.Offset("A1", 2, 2, 5, 6) ' "'SheetX'.$C$3:$H$7" + +Dim sOffset As String ' Return value +Dim oAddress As Object ' Alias of Range +Const cstThisSub = "SFDocuments.Calc.Offset" +Const cstSubArgs = "Range, [Rows=0], [Columns=0], [Height], [Width]" + + If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch + sOffset = "" + +Check: + If IsMissing(Rows) Or IsEmpty(Rows) Then Rows = 0 + If IsMissing(Columns) Or IsEmpty(Columns) Then Columns = 0 + If IsMissing(Height) Or IsEmpty(Height) Then Height = 0 + If IsMissing(Width) Or IsEmpty(Width) Then Width = 0 + If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then + If Not [_Super]._IsStillAlive() Then GoTo Finally + If Not ScriptForge.SF_Utils._Validate(Range, "Range", V_STRING) Then GoTo Finally + If Not ScriptForge.SF_Utils._Validate(Rows, "Rows", ScriptForge.V_NUMERIC) Then GoTo Finally + If Not ScriptForge.SF_Utils._Validate(Columns, "Columns", ScriptForge.V_NUMERIC) Then GoTo Finally + If Not ScriptForge.SF_Utils._Validate(Height, "Height", ScriptForge.V_NUMERIC) Then GoTo Finally + If Not ScriptForge.SF_Utils._Validate(Width, "Width", ScriptForge.V_NUMERIC) Then GoTo Finally + End If + +Try: + ' Define the new range string + Set oAddress = _Offset(Range, Rows, Columns, Height, Width) + sOffset = oAddress.RangeName + +Finally: + Offset = sOffset + ScriptForge.SF_Utils._ExitFunction(cstThisSub) + Exit Function +Catch: + GoTo Finally +End Function ' SF_Documents.SF_Calc.Offset + +REM ----------------------------------------------------------------------------- +Public Function Properties() As Variant +''' Return the list or properties of the Timer class as an array + + Properties = Array( _ + "CurrentSelection" _ + , "CustomProperties" _ + , "Description" _ + , "DocumentProperties" _ + , "DocumentType" _ + , "Height" _ + , "IsBase" _ + , "IsCalc" _ + , "IsDraw " _ + , "IsImpress" _ + , "IsMath" _ + , "IsWriter" _ + , "Keywords" _ + , "LastCell" _ + , "LastColumn" _ + , "LastRow" _ + , "Range" _ + , "Readonly" _ + , "Sheet" _ + , "Sheets" _ + , "Subject" _ + , "Title" _ + , "Width" _ + , "XCellRange" _ + , "XComponent" _ + , "XSpreadsheet" _ + ) + +End Function ' SFDocuments.SF_Calc.Properties + +REM ----------------------------------------------------------------------------- +Public Function RemoveSheet(Optional ByVal SheetName As Variant) As Boolean +''' Remove an existing sheet from the document +''' Args: +''' SheetName: The name of the sheet to remove +''' Returns: +''' True if the sheet could be removed successfully +''' Examples: +''' oDoc.RemoveSheet("SheetX") + +Dim bRemove As Boolean ' Return value +Const cstThisSub = "SFDocuments.Calc.RemoveSheet" +Const cstSubArgs = "SheetName" + + If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch + bRemove = False + +Check: + If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then + If Not [_Super]._IsStillAlive(True) Then GoTo Finally + If Not _ValidateSheet(SheetName, "SheetName", , True) Then GoTo Finally + End If + +Try: + _Component.getSheets.RemoveByName(SheetName) + bRemove = True + +Finally: + RemoveSheet = bRemove + ScriptForge.SF_Utils._ExitFunction(cstThisSub) + Exit Function +Catch: + GoTo Finally +End Function ' SFDocuments.SF_Calc.RemoveSheet + +REM ----------------------------------------------------------------------------- +Public Function RenameSheet(Optional ByVal SheetName As Variant _ + , Optional ByVal NewName As Variant _ + ) As Boolean +''' Rename a specified sheet +''' Args: +''' SheetName: The name of the sheet to rename +''' NewName: Must not exist +''' Returns: +''' True if the sheet could be renamed successfully +''' Exceptions: +''' DUPLICATESHEETERROR A sheet with the given name exists already +''' Examples: +''' oDoc.RenameSheet("SheetX", "SheetY") + +Dim bRename As Boolean ' Return value +Const cstThisSub = "SFDocuments.Calc.RenameSheet" +Const cstSubArgs = "SheetName, NewName" + + If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch + bRename = False + +Check: + If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then + If Not [_Super]._IsStillAlive(True) Then GoTo Finally + If Not _ValidateSheet(SheetName, "SheetName", , True) Then GoTo Finally + If Not _ValidateSheet(NewName, "NewName", True) Then GoTo Finally + End If + +Try: + _Component.getSheets.getByName(SheetName).setName(NewName) + bRename = True + +Finally: + RenameSheet = bRename + ScriptForge.SF_Utils._ExitFunction(cstThisSub) + Exit Function +Catch: + GoTo Finally +End Function ' SFDocuments.SF_Calc.RenameSheet + +REM ----------------------------------------------------------------------------- +Public Function SetArray(Optional ByVal TargetCell As Variant _ + , Optional ByRef Value As Variant _ + ) As String +''' Set the given (array of) values starting from the target cell +''' The updated area expands itself from the target cell or from the top-left corner of the given range +''' as far as determined by the size of the input Value. +''' Vectors are always expanded vertically +''' Args: +''' TargetCell : the cell or the range as a string that should receive a new value +''' Value: a scalar, a vector or an array with the new values +''' The new values should be strings, numeric values or dates. Other types empty the corresponding cell +''' Returns: +''' A string representing the updated range +''' Exceptions: +''' OFFSETADDRESSERROR The computed range of cells falls beyond the sheet boundaries +''' Examples: +''' oDoc.SetArray("SheetX.A1", SF_Array.RangeInit(1, 1000)) + +Dim sSet As String ' Return value +Dim oSet As Object ' _Address alias of sSet +Dim vDataArray As Variant ' DataArray compatible with .DataArray UNO property +Const cstThisSub = "SFDocuments.Calc.SetArray" +Const cstSubArgs = "TargetCell, Value" + + If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch + sSet = "" + +Check: + If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then + If Not [_Super]._IsStillAlive() Then GoTo Finally + If Not ScriptForge.SF_Utils._Validate(TargetCell, "TargetCell", V_STRING) Then GoTo Finally + If IsArray(Value) Then + If Not ScriptForge.SF_Utils._ValidateArray(Value, "Value") Then GoTo Finally + Else + If Not ScriptForge.SF_Utils._Validate(Value, "Value") Then GoTo Finally + End If + End If + +Try: + ' Convert argument to data array and derive new range from its size + vDataArray = _ConvertToDataArray(Value) + If UBound(vDataArray) < LBound(vDataArray) Then GoTo Finally + Set oSet = _Offset(TargetCell, 0, 0, plHeight := UBound(vDataArray) + 1, plWidth := UBound(vDataArray(0)) + 1) ' +1 : vDataArray is zero-based + With oSet + .XCellRange.setDataArray(vDataArray) + sSet = .RangeName + End With + +Finally: + SetArray = sSet + ScriptForge.SF_Utils._ExitFunction(cstThisSub) + Exit Function +Catch: + GoTo Finally +End Function ' SF_Documents.SF_Calc.SetArray + +REM ----------------------------------------------------------------------------- +Public Function SetCellStyle(Optional ByVal TargetRange As Variant _ + , Optional ByVal Style As Variant _ + ) As String +''' Apply the given cell style in the given range +''' The full range is updated and the remainder of the sheet is left untouched +''' If the cell style does not exist, an error is raised +''' Args: +''' TargetRange : the range as a string that should receive a new cell style +''' Style: the style name as a string +''' Returns: +''' A string representing the updated range +''' Examples: +''' oDoc.SetCellStyle("A1:F1", "Heading 2") + +Dim sSet As String ' Return value +Dim oAddress As _Address ' Alias of TargetRange +Dim oStyleFamilies As Object ' com.sun.star.container.XNameAccess +Dim vStyles As Variant ' Array of existing cell styles +Const cstStyle = "CellStyles" +Const cstThisSub = "SFDocuments.Calc.SetCellStyle" +Const cstSubArgs = "TargetRange, Style" + + If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch + sSet = "" + +Check: + If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then + If Not [_Super]._IsStillAlive() Then GoTo Finally + If Not ScriptForge.SF_Utils._Validate(TargetRange, "TargetRange", V_STRING) Then GoTo Finally + Set oStyleFamilies = _Component.StyleFamilies + If oStyleFamilies.hasByName(cstStyle) Then vStyles = oStyleFamilies.getByName(cstStyle).getElementNames() Else vStyles = Array() + If Not ScriptForge.SF_Utils._Validate(Style, "Style", V_STRING, vStyles) Then GoTo Finally + End If + +Try: + Set oAddress = _ParseAddress(TargetRange) + With oAddress + .XCellRange.CellStyle = Style + sSet = .RangeName + End With + +Finally: + SetCellStyle = sSet + ScriptForge.SF_Utils._ExitFunction(cstThisSub) + Exit Function +Catch: + GoTo Finally +End Function ' SF_Documents.SF_Calc.SetCellStyle + +REM ----------------------------------------------------------------------------- +Public Function SetFormula(Optional ByVal TargetRange As Variant _ + , Optional ByRef Formula As Variant _ + ) As String +''' Set the given (array of) formulae in the given range +''' The full range is updated and the remainder of the sheet is left untouched +''' If the given formula is a string: +''' the unique formula is pasted across the whole range with adjustment of the relative references +''' Otherwise +''' If the size of Formula < the size of Range, then the other cells are emptied +''' If the size of Formula > the size of Range, then Formula is only partially copied +''' Vectors are always expanded vertically, except if the range has a height of exactly 1 row +''' Args: +''' TargetRange : the range as a string that should receive a new Formula +''' Formula: a scalar, a vector or an array with the new formula(e) as strings for each cell of the range. +''' Returns: +''' A string representing the updated range +''' Examples: +''' oDoc.SetFormula("A1", "=A2") +''' oDoc.SetFormula("A1:F1", Array("=A2", "=B2", "=C2+10")) ' Horizontal vector, partially empty +''' oDoc.SetFormula("A1:D2", "=E1") ' D2 contains the formula "=H2" + +Dim sSet As String ' Return value +Dim oAddress As Object ' Alias of TargetRange +Dim vDataArray As Variant ' DataArray compatible with .DataArray UNO property +Const cstThisSub = "SFDocuments.Calc.SetFormula" +Const cstSubArgs = "TargetRange, Formula" + + If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch + sSet = "" + +Check: + If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then + If Not [_Super]._IsStillAlive() Then GoTo Finally + If Not ScriptForge.SF_Utils._Validate(TargetRange, "TargetRange", V_STRING) Then GoTo Finally + If IsArray(Formula) Then + If Not ScriptForge.SF_Utils._ValidateArray(Formula, "Formula", 0, V_STRING) Then GoTo Finally + Else + If Not ScriptForge.SF_Utils._Validate(Formula, "Formula", V_STRING) Then GoTo Finally + End If + End If + +Try: + Set oAddress = _ParseAddress(TargetRange) + With oAddress + If IsArray(Formula) Then + ' Convert to data array and limit its size to the size of the initial range + vDataArray = _ConvertToDataArray(Formula, .Height - 1, .Width - 1) + If UBound(vDataArray) < LBound(vDataArray) Then GoTo Finally + .XCellRange.setFormulaArray(vDataArray) + Else + With .XCellRange + ' Store formula in top-left cell and paste it along the whole range + .getCellByPosition(0, 0).setFormula(Formula) + .fillSeries(com.sun.star.sheet.FillDirection.TO_BOTTOM, com.sun.star.sheet.FillMode.SIMPLE, 0, 0, 0) + .fillSeries(com.sun.star.sheet.FillDirection.TO_RIGHT, com.sun.star.sheet.FillMode.SIMPLE, 0, 0, 0) + End With + End If + sSet = .RangeName + End With + +Finally: + SetFormula = sSet + ScriptForge.SF_Utils._ExitFunction(cstThisSub) + Exit Function +Catch: + GoTo Finally +End Function ' SF_Documents.SF_Calc.SetFormula + +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.Calc.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("CurrentSelection") + CurrentSelection = pvValue + 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_Calc.SetProperty + +REM ----------------------------------------------------------------------------- +Public Function SetValue(Optional ByVal TargetRange As Variant _ + , Optional ByRef Value As Variant _ + ) As String +''' Set the given value in the given range +''' The full range is updated and the remainder of the sheet is left untouched +''' If the size of Value < the size of Range, then the other cells are emptied +''' If the size of Value > the size of Range, then Value is only partially copied +''' Vectors are always expanded vertically, except if the range has a height of exactly 1 row +''' Args: +''' TargetRange : the range as a string that should receive a new value +''' Value: a scalar, a vector or an array with the new values for each cell of the range. +''' The new values should be strings, numeric values or dates. Other types empty the corresponding cell +''' Returns: +''' A string representing the updated range +''' Examples: +''' oDoc.SetValue("A1", 2) +''' oDoc.SetValue("A1:F1", Array(1, 2, 3)) ' Horizontal vector, partially empty +''' oDoc.SetValue("A1:D2", SF_Array.AppendRow(Array(1, 2, 3, 4), Array(5, 6, 7, 8))) + +Dim sSet As String ' Return value +Dim oAddress As Object ' Alias of TargetRange +Dim vDataArray As Variant ' DataArray compatible with .DataArray UNO property +Const cstThisSub = "SFDocuments.Calc.SetValue" +Const cstSubArgs = "TargetRange, Value" + + If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch + sSet = "" + +Check: + If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then + If Not [_Super]._IsStillAlive() Then GoTo Finally + If Not ScriptForge.SF_Utils._Validate(TargetRange, "TargetRange", V_STRING) Then GoTo Finally + If IsArray(Value) Then + If Not ScriptForge.SF_Utils._ValidateArray(Value, "Value") Then GoTo Finally + Else + If Not ScriptForge.SF_Utils._Validate(Value, "Value") Then GoTo Finally + End If + End If + +Try: + Set oAddress = _ParseAddress(TargetRange) + With oAddress + ' Convert to data array and limit its size to the size of the initial range + vDataArray = _ConvertToDataArray(Value, .Height - 1, .Width - 1) + If UBound(vDataArray) < LBound(vDataArray) Then GoTo Finally + .XCellRange.setDataArray(vDataArray) + sSet = .RangeName + End With + +Finally: + SetValue = sSet + ScriptForge.SF_Utils._ExitFunction(cstThisSub) + Exit Function +Catch: + GoTo Finally +End Function ' SF_Documents.SF_Calc.SetValue + +REM ----------------------------------------------------------------------------- +Public Function SortRange(Optional ByVal Range As Variant _ + , Optional ByVal SortKeys As Variant _ + , Optional ByVal SortOrder As Variant _ + , Optional ByVal DestinationCell As Variant _ + , Optional ByVal ContainsHeader As Variant _ + , Optional ByVal CaseSensitive As Variant _ + , Optional ByVal SortColumns As Variant _ + ) As Variant +''' Sort the given range on maximum 3 columns/rows. The sorting order may vary by column/row +''' Args: +''' Range: the range to sort as a string +''' SortKeys: a scalar (if 1 column/row) or an array of column/row numbers starting from 1 +''' SortOrder: a scalar or an array of strings: "ASC" or "DESC" +''' Each item is paired with the corresponding item in SortKeys +''' If the SortOrder array is shorter than SortKeys, the remaining keys are sorted +''' in ascending order +''' DestinationCell: the destination of the sorted range of cells, as a string +''' If given as range, the destination will be reduced to its top-left cell +''' By default, Range is overwritten with its sorted content +''' ContainsHeader: when True, the first row/column is not sorted +''' CaseSensitive: only for string comparisons, default = False +''' SortColumns: when True, the columns are sorted from left to right +''' Default = False: rows are sorted from top to bottom. +''' Returns: +''' The modified range of cells as a string +''' Example: +''' oDoc.SortRange("A2:J200", Array(1, 3), , Array("ASC", "DESC"), CaseSensitive := True) +''' ' Sort on columns A (ascending) and C (descending) + +Dim sSort As String ' Return value +Dim oRangeAddress As _Address ' Parsed range +Dim oRange As Object ' com.sun.star.table.XCellRange +Dim oDestRange As Object ' Destination as a range +Dim oDestAddress As Object ' com.sun.star.table.CellRangeAddress +Dim oDestCell As Object ' com.sun.star.table.CellAddress +Dim vSortDescriptor As Variant ' Array of com.sun.star.beans.PropertyValue +Dim vSortFields As Variant ' Array of com.sun.star.table.TableSortField +Dim sOrder As String ' Item in SortOrder +Dim i As Long +Const cstThisSub = "SFDocuments.Calc.SortRange" +Const cstSubArgs = "Range, SortKeys, [TargetRange=""""], [SortOrder=""ASC""], [ContainsHeader=False], [CaseSensitive=False], [SortColumns=False]" + + If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch + sSort = "" + +Check: + If IsMissing(SortKeys) Or IsEmpty(SortKeys) Then + SortKeys = Array(1) + ElseIf Not IsArray(SortKeys) Then + SortKeys = Array(SortKeys) + End If + If IsMissing(DestinationCell) Or IsEmpty(DestinationCell) Then DestinationCell = "" + If IsMissing(SortOrder) Or IsEmpty(SortOrder) Then + SortOrder = Array("ASC") + ElseIf Not IsArray(SortOrder) Then + SortOrder = Array(SortOrder) + End If + If IsMissing(ContainsHeader) Or IsEmpty(ContainsHeader) Then ContainsHeader = False + If IsMissing(CaseSensitive) Or IsEmpty(CaseSensitive) Then CaseSensitive = False + If IsMissing(SortColumns) Or IsEmpty(SortColumns) Then SortColumns = False + If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then + If Not [_Super]._IsStillAlive() Then GoTo Finally + If Not ScriptForge.SF_Utils._Validate(Range, "Range", V_STRING) Then GoTo Finally + If Not ScriptForge.SF_Utils._ValidateArray(SortKeys, "SortKeys", 1, V_NUMERIC, True) Then GoTo Finally + If Not ScriptForge.SF_Utils._Validate(DestinationCell, "DestinationCell", V_STRING) Then GoTo Finally + If Not ScriptForge.SF_Utils._ValidateArray(SortOrder, "SortOrder", 1, V_STRING, True) Then GoTo Finally + If Not ScriptForge.SF_Utils._Validate(ContainsHeader, "ContainsHeader", V_BOOLEAN) Then GoTo Finally + If Not ScriptForge.SF_Utils._Validate(CaseSensitive, "CaseSensitive", V_BOOLEAN) Then GoTo Finally + If Not ScriptForge.SF_Utils._Validate(SortColumns, "SortColumns", V_BOOLEAN) Then GoTo Finally + End If + Set oRangeAddress = _ParseAddress(Range) + If Len(DestinationCell) > 0 Then Set oDestRange = _ParseAddress(DestinationCell) + +Try: + ' Initialize the sort descriptor + Set oRange = oRangeAddress.XCellRange + vSortDescriptor = oRange.createSortDescriptor + ScriptForge.SF_Utils._SetPropertyValue(vSortDescriptor, "IsSortColumns", SortColumns) + ScriptForge.SF_Utils._SetPropertyValue(vSortDescriptor, "ContainsHeader", ContainsHeader) + ScriptForge.SF_Utils._SetPropertyValue(vSortDescriptor, "BindFormatsToContent", True) + If Len(DestinationCell) = 0 Then + ScriptForge.SF_Utils._SetPropertyValue(vSortDescriptor, "CopyOutputData", False) + Else + Set oDestAddress = oDestRange.XCellRange.RangeAddress + Set oDestCell = New com.sun.star.table.CellAddress + With oDestAddress + oDestCell.Sheet = .Sheet + oDestCell.Column = .StartColumn + oDestCell.Row = .StartRow + End With + ScriptForge.SF_Utils._SetPropertyValue(vSortDescriptor, "CopyOutputData", true) + ScriptForge.SF_Utils._SetPropertyValue(vSortDescriptor, "OutputPosition", oDestCell) + End If + ScriptForge.SF_Utils._SetPropertyValue(vSortDescriptor, "IsUserListEnabled", False) + + ' Define the sorting keys + vSortFields = Array() + ReDim vSortFields(0 To UBound(SortKeys)) + For i = 0 To UBound(SortKeys) + vSortFields(i) = New com.sun.star.table.TableSortField + If i > UBound(SortOrder) Then sOrder = "" Else sOrder = SortOrder(i) + If Len(sOrder) = 0 Then sOrder = "ASC" + With vSortFields(i) + .Field = SortKeys(i) - 1 + .IsAscending = ( UCase(sOrder) = "ASC" ) + .IsCaseSensitive = CaseSensitive + End With + Next i + + ' Associate the keys and the descriptor, and sort + ScriptForge.SF_Utils._SetPropertyValue(vSortDescriptor, "SortFields", vSortFields) + oRange.sort(vSortDescriptor) + + ' Compute the changed area + If Len(DestinationCell) = 0 Then + sSort = oRangeAddress.RangeName + Else + With oRangeAddress + sSort = _Offset(oDestRange, 0, 0, .Height, .Width).RangeName + End With + End If + +Finally: + SortRange = sSort + ScriptForge.SF_Utils._ExitFunction(cstThisSub) + Exit Function +Catch: + GoTo Finally +End Function ' SF_Documents.SF_Calc.SortRange + +REM ======================================================= SUPERCLASS PROPERTIES + +REM ----------------------------------------------------------------------------- +Property Get CustomProperties() As Variant + CustomProperties = [_Super].GetProperty("CustomProperties") +End Property ' SFDocuments.SF_Calc.CustomProperties + +REM ----------------------------------------------------------------------------- +Property Let CustomProperties(Optional ByVal pvCustomProperties As Variant) + [_Super].CustomProperties = pvCustomProperties +End Property ' SFDocuments.SF_Calc.CustomProperties + +REM ----------------------------------------------------------------------------- +Property Get Description() As Variant + Description = [_Super].GetProperty("Description") +End Property ' SFDocuments.SF_Calc.Description + +REM ----------------------------------------------------------------------------- +Property Let Description(Optional ByVal pvDescription As Variant) + [_Super].Description = pvDescription +End Property ' SFDocuments.SF_Calc.Description + +REM ----------------------------------------------------------------------------- +Property Get DocumentProperties() As Variant + DocumentProperties = [_Super].GetProperty("DocumentProperties") +End Property ' SFDocuments.SF_Calc.DocumentProperties + +REM ----------------------------------------------------------------------------- +Property Get DocumentType() As String + DocumentType = [_Super].GetProperty("DocumentType") +End Property ' SFDocuments.SF_Calc.DocumentType + +REM ----------------------------------------------------------------------------- +Property Get IsBase() As Boolean + IsBase = [_Super].GetProperty("IsBase") +End Property ' SFDocuments.SF_Calc.IsBase + +REM ----------------------------------------------------------------------------- +Property Get IsCalc() As Boolean + IsCalc = [_Super].GetProperty("IsCalc") +End Property ' SFDocuments.SF_Calc.IsCalc + +REM ----------------------------------------------------------------------------- +Property Get IsDraw() As Boolean + IsDraw = [_Super].GetProperty("IsDraw") +End Property ' SFDocuments.SF_Calc.IsDraw + +REM ----------------------------------------------------------------------------- +Property Get IsImpress() As Boolean + IsImpress = [_Super].GetProperty("IsImpress") +End Property ' SFDocuments.SF_Calc.IsImpress + +REM ----------------------------------------------------------------------------- +Property Get IsMath() As Boolean + IsMath = [_Super].GetProperty("IsMath") +End Property ' SFDocuments.SF_Calc.IsMath + +REM ----------------------------------------------------------------------------- +Property Get IsWriter() As Boolean + IsWriter = [_Super].GetProperty("IsWriter") +End Property ' SFDocuments.SF_Calc.IsWriter + +REM ----------------------------------------------------------------------------- +Property Get Keywords() As Variant + Keywords = [_Super].GetProperty("Keywords") +End Property ' SFDocuments.SF_Calc.Keywords + +REM ----------------------------------------------------------------------------- +Property Let Keywords(Optional ByVal pvKeywords As Variant) + [_Super].Keywords = pvKeywords +End Property ' SFDocuments.SF_Calc.Keywords + +REM ----------------------------------------------------------------------------- +Property Get Readonly() As Variant + Readonly = [_Super].GetProperty("Readonly") +End Property ' SFDocuments.SF_Calc.Readonly + +REM ----------------------------------------------------------------------------- +Property Get Subject() As Variant + Subject = [_Super].GetProperty("Subject") +End Property ' SFDocuments.SF_Calc.Subject + +REM ----------------------------------------------------------------------------- +Property Let Subject(Optional ByVal pvSubject As Variant) + [_Super].Subject = pvSubject +End Property ' SFDocuments.SF_Calc.Subject + +REM ----------------------------------------------------------------------------- +Property Get Title() As Variant + Title = [_Super].GetProperty("Title") +End Property ' SFDocuments.SF_Calc.Title + +REM ----------------------------------------------------------------------------- +Property Let Title(Optional ByVal pvTitle As Variant) + [_Super].Title = pvTitle +End Property ' SFDocuments.SF_Calc.Title + +REM ----------------------------------------------------------------------------- +Property Get XComponent() As Variant + XComponent = [_Super].GetProperty("XComponent") +End Property ' SFDocuments.SF_Calc.XComponent + +REM ========================================================== SUPERCLASS METHODS + +REM ----------------------------------------------------------------------------- +'Public Function Activate() As Boolean +' Activate = [_Super].Activate() +'End Function ' SFDocuments.SF_Calc.Activate + +REM ----------------------------------------------------------------------------- +Public Function CloseDocument(Optional ByVal SaveAsk As Variant) As Boolean + CloseDocument = [_Super].CloseDocument(SaveAsk) +End Function ' SFDocuments.SF_Calc.CloseDocument + +REM ----------------------------------------------------------------------------- +Public Sub RunCommand(Optional ByVal Command As Variant) + [_Super].RunCommand(Command) +End Sub ' SFDocuments.SF_Calc.RunCommand + +REM ----------------------------------------------------------------------------- +Public Function Save() As Boolean + Save = [_Super].Save() +End Function ' SFDocuments.SF_Calc.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 + SaveAs = [_Super].SaveAs(FileName, Overwrite, Password, FilterName, FilterOptions) +End Function ' SFDocuments.SF_Calc.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 + SaveCopyAs = [_Super].SaveCopyAs(FileName, Overwrite, Password, FilterName, FilterOptions) +End Function ' SFDocuments.SF_Calc.SaveCopyAs + +REM =========================================================== PRIVATE FUNCTIONS + +REM ----------------------------------------------------------------------------- +Public Function _ConvertFromDataArray(ByRef pvDataArray As Variant) As Variant +''' Convert a data array to a scalar, a vector or a 2D array +''' Args: +''' pvDataArray: an array as returned by the XCellRange.getDatArray or .getFormulaArray methods +''' Returns: +''' A scalar, a zero-based 1D array or a zero-based 2D array of strings and/or doubles +''' To convert doubles to dates, use the CDate builtin function + +Dim vArray As Variant ' Return value +Dim lMax1 As Long ' UBound of pvDataArray +Dim lMax2 As Long ' UBound of pvDataArray items +Dim i As Long +Dim j As Long + + vArray = Empty + +Try: + ' Convert the data array to scalar, vector or array + lMax1 = UBound(pvDataArray) + If lMax1 >= 0 Then + lMax2 = UBound(pvDataArray(0)) + If lMax2 >= 0 Then + If lMax1 + lMax2 > 0 Then vArray = Array() + Select Case True + Case lMax1 = 0 And lMax2 = 0 ' Scalar + vArray = pvDataArray(0)(0) + Case lMax1 > 0 And lMax2 = 0 ' Vertical vector + ReDim vArray(0 To lMax1) + For i = 0 To lMax1 + vArray(i) = pvDataArray(i)(0) + Next i + Case lMax1 = 0 And lMax2 > 0 ' Horizontal vector + ReDim vArray(0 To lMax2) + For j = 0 To lMax2 + vArray(j) = pvDataArray(0)(j) + Next j + Case Else ' Array + ReDim vArray(0 To lMax1, 0 To lMax2) + For i = 0 To lMax1 + For j = 0 To lMax2 + vArray(i, j) = pvDataArray(i)(j) + Next j + Next i + End Select + End If + End If + +Finally: + _ConvertFromDataArray = vArray +End Function ' SF_Documents.SF_Calc._ConvertFromDataArray + +REM ----------------------------------------------------------------------------- +Private Function _ConvertToCellValue(ByVal pvItem As Variant) As Variant +''' Convert the argument to a valid Calc cell content + +Dim vCell As Variant ' Return value + +Try: + Select Case ScriptForge.SF_Utils._VarTypeExt(pvItem) + Case V_STRING : vCell = pvItem + Case V_DATE : vCell = CDbl(pvItem) + Case ScriptForge.V_NUMERIC : vCell = CDbl(pvItem) + Case ScriptForge.V_BOOLEAN : vCell = CDbl(Iif(pvItem, 1, 0)) + Case Else : vCell = "" + End Select + +Finally: + _ConvertToCellValue = vCell + Exit Function +End Function ' SF_Documents.SF_Calc._ConvertToCellValue + +REM ----------------------------------------------------------------------------- +Private Function _ConvertToDataArray(ByRef pvArray As Variant _ + , Optional ByVal plRows As Long _ + , Optional ByVal plColumns As Long _ + ) As Variant +''' Create a 2-dimensions nested array (compatible with the ranges .DataArray property) +''' from a scalar, a 1D array or a 2D array +''' Array items are converted to (possibly empty) strings or doubles +''' Args: +''' pvArray: the input scalar or array. If array, must be 1 or 2D otherwise it is ignored. +''' plRows, plColumns: the upper bounds of the data array +''' If bigger than input array, fill with zero-length strings +''' If smaller than input array, truncate +''' If plRows = 0 and the input array is a vector, the data array is aligned horizontally +''' They are either both present or both absent +''' When absent +''' The size of the output is fully determined by the input array +''' Vectors are aligned vertically +''' Returns: +''' A data array compatible with ranges .DataArray property +''' The output is always an array of nested arrays + +Dim vDataArray() As Variant ' Return value +Dim vVector() As Variant ' A temporary 1D array +Dim vItem As Variant ' A single input item +Dim iDims As Integer ' Number of dimensions of the input argument +Dim lMin1 As Long ' Lower bound of input array +Dim lMax1 As Long ' Upper bound +Dim lMin2 As Long ' Lower bound +Dim lMax2 As Long ' Upper bound +Dim lRows As Long ' Upper bound of vDataArray +Dim lCols As Long ' Upper bound of vVector +Dim bHorizontal As Boolean ' Horizontal vector +Dim i As Long +Dim j As Long + +Const cstEmpty = "" ' Empty cell + + If IsMissing(plRows) Or IsEmpty(plRows) Then plRows = -1 + If IsMissing(plColumns) Or IsEmpty(plColumns) Then plColumns = -1 + + vDataArray = Array() + +Try: + ' Check the input argument and know its boundaries + iDims = ScriptForge.SF_Array.CountDims(pvArray) + If iDims = 0 Or iDims > 2 Then Exit Function + lMin1 = 0 : lMax1 = 0 ' Default values + lMin2 = 0 : lMax2 = 0 + Select Case iDims + Case -1 ' Scalar value + Case 1 + bHorizontal = ( plRows = 0 And plColumns > 0) + If Not bHorizontal Then + lMin1 = LBound(pvArray) : lMax1 = UBound(pvArray) + Else + lMin2 = LBound(pvArray) : lMax2 = UBound(pvArray) + End If + Case 2 + lMin1 = LBound(pvArray, 1) : lMax1 = UBound(pvArray, 1) + lMin2 = LBound(pvArray, 2) : lMax2 = UBound(pvArray, 2) + End Select + + ' Set the output dimensions accordingly + If plRows >= 0 Then ' Dimensions of output are imposed + lRows = plRows + lCols = plColumns + Else ' Dimensions of output determined by input argument + lRows = 0 : lCols = 0 ' Default values + Select Case iDims + Case -1 ' Scalar value + Case 1 ' Vectors are aligned vertically + lRows = lMax1 - lMin1 + Case 2 + lRows = lMax1 - lMin1 + lCols = lMax2 - lMin2 + End Select + End If + ReDim vDataArray(0 To lRows) + + ' Feed the output array row by row, each row being a vector + For i = 0 To lRows + ReDim vVector(0 To lCols) + For j = 0 To lCols + If i > lMax1 - lMin1 Then + vVector(j) = cstEmpty + ElseIf j > lMax2 - lMin2 Then + vVector(j) = cstEmpty + Else + Select Case iDims + Case -1 : vItem = _ConvertToCellValue(pvArray) + Case 1 + If bHorizontal Then + vItem = _ConvertToCellValue(pvArray(j + lMin2)) + Else + vItem = _ConvertToCellValue(pvArray(i + lMin1)) + End If + Case 2 + vItem = _ConvertToCellValue(pvArray(i + lMin1, j + lMin2)) + End Select + vVector(j) = vItem + End If + vDataArray(i) = vVector + Next j + Next i + +Finally: + _ConvertToDataArray = vDataArray + Exit Function +End Function ' SF_Documents.SF_Calc._ConvertToDataArray + +REM ----------------------------------------------------------------------------- +Private Function _DFunction(ByVal psFunction As String _ + , Optional ByVal Range As Variant _ + ) As Double +''' Apply the given function on all the numeric values stored in the given range +''' Args: +''' Range : the range as a string where to apply the function on +''' Returns: +''' The resulting value as a double + +Dim dblGet As Double ' Return value +Dim oAddress As Object ' Alias of Range +Dim vFunction As Variant ' com.sun.star.sheet.GeneralFunction.XXX +Dim cstThisSub As String : cstThisSub = "SFDocuments.Calc." & psFunction +Const cstSubArgs = "Range" + + If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch + dblGet = 0 + +Check: + If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then + If Not [_Super]._IsStillAlive() Then GoTo Finally + If Not ScriptForge.SF_Utils._Validate(Range, "Range", V_STRING) Then GoTo Finally + End If + +Try: + ' Get the data + Set oAddress = _ParseAddress(Range) + Select Case psFunction + Case "DAvg" : vFunction = com.sun.star.sheet.GeneralFunction.AVERAGE + Case "DCount" : vFunction = com.sun.star.sheet.GeneralFunction.COUNTNUMS + Case "DMax" : vFunction = com.sun.star.sheet.GeneralFunction.MAX + Case "DMin" : vFunction = com.sun.star.sheet.GeneralFunction.MIN + Case "DSum" : vFunction = com.sun.star.sheet.GeneralFunction.SUM + Case Else : GoTo Finally + End Select + dblGet = oAddress.XCellRange.computeFunction(vFunction) + +Finally: + _DFunction = dblGet + ScriptForge.SF_Utils._ExitFunction(cstThisSub) + Exit Function +Catch: + GoTo Finally +End Function ' SF_Documents.SF_Calc._DFunction + +REM ----------------------------------------------------------------------------- +Function _GetColumnName(ByVal plColumnNumber As Long) As String +''' Convert a column number (range 1, 2,..1024) into its letter counterpart (range 'A', 'B',..'AMJ'). +''' Args: +''' ColumnNumber: the column number, must be in the interval 1 ... 1024 +''' Returns: +''' a string representation of the column name, in range 'A'..'AMJ' +''' Adapted from a Python function by sundar nataraj +''' http://stackoverflow.com/questions/23861680/convert-spreadsheet-number-to-column-letter + +Dim sCol As String ' Return value +Dim lDiv As Long ' Intermediate result +Dim lMod As Long ' Result of modulo 26 operation + +Try: + lDiv = plColumnNumber + Do While lDiv > 0 + lMod = (lDiv - 1) Mod 26 + sCol = Chr(65 + lMod) + sCol + lDiv = Int((lDiv - lMod)/26) + Loop + +Finally: + _GetColumnName = sCol +End Function ' SFDocuments.SF_Calc._GetColumnName + +REM ----------------------------------------------------------------------------- +Private Function _LastCell(ByRef poSheet As Object) As Variant +''' Returns in an array the coordinates of the last used cell in the given sheet + +Dim oCursor As Object ' Cursor on the cell +Dim oRange As Object ' The used range +Dim vCoordinates(0 To 1) As Long ' Return value: (0) = Column, (1) = Row + +Try: + Set oCursor = poSheet.createCursorByRange(poSheet.getCellRangeByName("A1")) + oCursor.gotoEndOfUsedArea(True) + Set oRange = poSheet.getCellRangeByName(oCursor.AbsoluteName) + + vCoordinates(0) = oRange.RangeAddress.EndColumn + 1 + vCoordinates(1) = oRange.RangeAddress.EndRow + 1 + +Finally: + _LastCell = vCoordinates +End Function ' SFDocuments.SF_Calc._LastCell + +REM ----------------------------------------------------------------------------- +Public Function _Offset(ByRef pvRange As Variant _ + , ByVal plRows As Long _ + , ByVal plColumns As Long _ + , ByVal plHeight As Long _ + , ByVal plWidth As Long _ + ) As Object +''' Returns a new range offset by a certain number of rows and columns from a given range +''' Args: +''' pvRange : the range, as a string or an object, from which the function searches for the new range +''' plRows : the number of rows by which the reference was corrected up (negative value) or down. +''' plColumns : the number of columns by which the reference was corrected to the left (negative value) or to the right. +''' plHeight : the vertical height for an area that starts at the new reference position. +''' plWidth : the horizontal width for an area that starts at the new reference position. +''' Arguments Rows and Columns must not lead to zero or negative start row or column. +''' Arguments Height and Width must not lead to zero or negative count of rows or columns. +''' Returns: +''' A new range as object of type _Address +''' Exceptions: +''' OFFSETADDRESSERROR The computed range of cells falls beyond the sheet boundaries + +Dim oOffset As Object ' Return value +Dim oAddress As Object ' Alias of Range +Dim oSheet As Object ' com.sun.star.sheet.XSpreadsheet +Dim oRange As Object ' com.sun.star.table.XCellRange +Dim oNewRange As Object ' com.sun.star.table.XCellRange +Dim lLeft As Long ' New range coordinates +Dim lTop As Long +Dim lRight As Long +Dim lBottom As Long + + Set oOffset = Nothing + +Check: + If plHeight < 0 Or plWidth < 0 Then GoTo CatchAddress + +Try: + If VarType(pvRange) = V_STRING Then Set oAddress = _ParseAddress(pvRange) Else Set oAddress = pvRange + Set oSheet = oAddress.XSpreadSheet + Set oRange = oAddress.XCellRange.RangeAddress + + + ' Compute and validate new coordinates + With oRange + lLeft = .StartColumn + plColumns + lTop = .StartRow + plRows + lRight = lLeft + Iif(plWidth = 0, .EndColumn - .StartColumn, plWidth - 1) + lBottom = lTop + Iif(plHeight = 0, .EndRow - .StartRow, plHeight - 1) + If lLeft < 0 Or lRight < 0 Or lTop < 0 Or lBottom < 0 _ + Or lLeft > MAXCOLS Or lRight > MAXCOLS _ + Or lTop > MAXROWS Or lBottom > MAXROWS _ + Then GoTo CatchAddress + Set oNewRange = oSheet.getCellRangeByPosition(lLeft, lTop, lRight, lBottom) + End With + + ' Define the new range address + Set oOffset = New _Address + With oOffset + .ObjectType = CALCREFERENCE + .RawAddress = oNewRange.AbsoluteName + .Component = _Component + .XSpreadsheet = oNewRange.Spreadsheet + .SheetName = .XSpreadsheet.Name + .SheetIndex = .XSpreadsheet.RangeAddress.Sheet + .RangeName = .RawAddress + .XCellRange = oNewRange + .Height = oNewRange.RangeAddress.EndRow - oNewRange.RangeAddress.StartRow + 1 + .Width = oNewRange.RangeAddress.EndColumn - oNewRange.RangeAddress.StartColumn + 1 + End With + +Finally: + Set _Offset = oOffset + Exit Function +Catch: + GoTo Finally +CatchAddress: + ScriptForge.SF_Exception.RaiseFatal(OFFSETADDRESSERROR, "Range", oAddress.RawAddress _ + , "Rows", plRows, "Columns", plColumns, "Height", plHeight, "Width", plWidth _ + , "Document", [_Super]._FileIdent()) + GoTo Finally +End Function ' SF_Documents.SF_Calc._Offset + +REM ----------------------------------------------------------------------------- +Private Function _ParseAddress(ByVal psAddress As String) As Object +''' Parse and validate a sheet or range reference +''' Syntax to parse: +''' [Sheet].[Range] +''' Sheet => ['][$]sheet['] or document named range or ~ +''' Range => A1:D10, A1, A:D, 10:10 ($ ignored), or sheet named range or ~ +''' Returns: +''' An object of type _Address +''' Exceptions: +''' CALCADDRESSERROR ' Adrress could not be parsed to a valid address + +Dim oAddress As _Address ' Return value +Dim lStart As Long ' Position of found regex +Dim sSheet As String ' Sheet component +Dim sRange As String ' Range component +Dim oSheets As Object ' com.sun.star.sheet.XSpreadsheets +Dim oNamedRanges As Object ' com.sun.star.sheet.XNamedRanges +Dim oRangeAddress As Object ' Alias for rangeaddress +Dim vLastCell As Variant ' Result of _LastCell() method +Dim oSelect As Object ' Current selection + + With oAddress + sSheet = "" : sRange = "" + .SheetName = "" : .RangeName = "" + + .ObjectType = CALCREFERENCE + .RawAddress = psAddress + Set .XSpreadSheet = Nothing : Set .XCellRange = Nothing + + ' Split in sheet and range components - Check presence of surrounding single quotes or dot + If Left(psAddress, 1) = "'" Then + lStart = 1 + sSheet = ScriptForge.SF_String.FindRegex(psAddress, "^'[^\[\]*?:\/\\]+'") + If lStart = 0 Then GoTo CatchAddress ' Invalid sheet name + If Len(psAddress) > Len(sSheet) + 1 Then + If Mid(psAddress, Len(sSheet) + 1, 1) = "." then sRange = Mid(psAddress, Len(sSheet) + 2) + End If + sSheet = Replace(Replace(sSheet, "$", ""), "'", "") + ElseIf InStr(psAddress, ".") > 0 Then + sSheet = Replace(Split(psAddress, ".")(0), "$", "") + sRange = Replace(Split(psAddress, ".")(1), "$", "") + Else + sSheet = psAddress + End If + + ' Resolve sheet part: either a document named range, or the active sheet or a real sheet + Set oSheets = _Component.getSheets() + Set oNamedRanges = _Component.NamedRanges + If oSheets.hasByName(sSheet) Then + ElseIf sSheet = "~" And Len(sRange) > 0 Then + sSheet = _Component.CurrentController.ActiveSheet.Name + ElseIf oNamedRanges.hasByName(sSheet) Then + .XCellRange = oNamedRanges.getByName(sSheet).ReferredCells + sSheet = oSheets.getByIndex(oNamedRanges.getByName(sSheet).ReferencePosition.Sheet).Name + Else + sRange = sSheet + sSheet = _Component.CurrentController.ActiveSheet.Name + End If + .SheetName = sSheet + .XSpreadSheet = oSheets.getByName(sSheet) + .SheetIndex = .XSpreadSheet.RangeAddress.Sheet + + ' Resolve range part - either a sheet named range or the current selection or a real range or "" + If IsNull(.XCellRange) Then + Set oNamedRanges = .XSpreadSheet.NamedRanges + If sRange = "~" Then + Set oSelect = _Component.CurrentController.getSelection() + If oSelect.supportsService("com.sun.star.sheet.SheetCellRanges") Then ' Multiple selections + Set .XCellRange = oSelect.getByIndex(0) + Else + Set .XCellRange = oSelect + End If + ElseIf sRange = "*" Or sRange = "" Then + vLastCell = _LastCell(.XSpreadSheet) + sRange = "A1:" & _GetColumnName(vLastCell(0)) & CStr(vLastCell(1)) + Set .XCellRange = .XSpreadSheet.getCellRangeByName(sRange) + ElseIf oNamedRanges.hasByName(sRange) Then + .XCellRange = oNamedRanges.getByName(sRange).ReferredCells + Else + On Local Error GoTo CatchError + Set .XCellRange = .XSpreadSheet.getCellRangeByName(sRange) + ' If range reaches the limits of the sheets, reduce it up to the used area + Set oRangeAddress = .XCellRange.RangeAddress + If oRangeAddress.StartColumn = 0 And oRangeAddress.EndColumn = MAXCOLS - 1 Then + vLastCell = _LastCell(.XSpreadSheet) + sRange = "A" & CStr(oRangeAddress.StartRow + 1) & ":" _ + & _GetColumnName(vLastCell(0)) & CStr(oRangeAddress.EndRow + 1) + Set .XCellRange = .XSpreadSheet.getCellRangeByName(sRange) + ElseIf oRangeAddress.StartRow = 0 And oRangeAddress.EndRow = MAXROWS - 1 Then + vLastCell = _LastCell(.XSpreadSheet) + sRange = _GetColumnName(oRangeAddress.StartColumn + 1) & "1" & ":" _ + & _GetColumnName(oRangeAddress.EndColumn + 1) & CStr(_LastCell(.XSpreadSheet)(1)) + Set .XCellRange = .XSpreadSheet.getCellRangeByName(sRange) + End If + End If + End If + If IsNull(.XCellRange) Then GoTo CatchAddress + + Set oRangeAddress = .XCellRange.RangeAddress + .RangeName = _RangeToString(oRangeAddress) + .Height = oRangeAddress.EndRow - oRangeAddress.StartRow + 1 + .Width = oRangeAddress.EndColumn - oRangeAddress.StartColumn + 1 + + ' Remember the current component in case of use outside the current instance + Set .Component = _Component + + End With + +Finally: + Set _ParseAddress = oAddress + Exit Function +CatchError: + ScriptForge.SF_Exception.Clear() +CatchAddress: + ScriptForge.SF_Exception.RaiseFatal(CALCADDRESSERROR, "Range", psAddress _ + , "Document", [_Super]._FileIdent()) + GoTo Finally +End Function ' SFDocuments.SF_Calc._ParseAddress + +REM ----------------------------------------------------------------------------- +Private Function _PropertyGet(Optional ByVal psProperty As String _ + , Optional ByVal pvArg As Variant _ + ) 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 vLastCell As Variant ' Coordinates of last used cell in a sheet +Dim oSelect As Object ' Current selection +Dim vRanges As Variant ' List of selected ranges +Dim i As Long +Dim cstThisSub As String +Const cstSubArgs = "" + + _PropertyGet = False + + cstThisSub = "SFDocuments.SF_Calc.get" & psProperty + ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) + If Not [_Super]._IsStillAlive() Then GoTo Finally + + Select Case psProperty + Case "CurrentSelection" + Set oSelect = _Component.CurrentController.getSelection() + If IsNull(oSelect) Then + _PropertyGet = Array() + ElseIf oSelect.supportsService("com.sun.star.sheet.SheetCellRanges") Then ' Multiple selections + vRanges = Array() + For i = 0 To oSelect.Count - 1 + vRanges = ScriptForge.SF_Array.Append(vRanges, oSelect.getByIndex(i).AbsoluteName) + Next i + _PropertyGet = vRanges + Else + _PropertyGet = oSelect.AbsoluteName + End If + Case "Height" + If IsMissing(pvArg) Or IsEmpty(pvArg) Then + _PropertyGet = 0 + Else + If Not ScriptForge.SF_Utils._Validate(pvArg, "Range", V_STRING) Then GoTo Finally + _PropertyGet = _ParseAddress(pvArg).Height + End If + Case "LastCell", "LastColumn", "LastRow" + If IsMissing(pvArg) Or IsEmpty(pvArg) Then ' Avoid errors when instance is watched in Basic IDE + _PropertyGet = -1 + Else + If Not _ValidateSheet(pvArg, "SheetName", , True) Then GoTo Finally + vLastCell = _LastCell(_Component.getSheets.getByName(pvArg)) + If psProperty = "LastRow" Then + _PropertyGet = vLastCell(1) + ElseIf psProperty = "LastColumn" Then + _PropertyGet = vLastCell(0) + Else + _PropertyGet = GetColumnName(vLastCell(0)) & CStr(vLastCell(1)) + End If + End If + Case "Range" + If IsMissing(pvArg) Or IsEmpty(pvArg) Then + Set _PropertyGet = Nothing + Else + If Not ScriptForge.SF_Utils._Validate(pvArg, "Range", V_STRING) Then GoTo Finally + Set _PropertyGet = _ParseAddress(pvArg) + End If + Case "Sheet" + If IsMissing(pvArg) Or IsEmpty(pvArg) Then + Set _PropertyGet = Nothing + Else + If Not _ValidateSheet(pvArg, "SheetName", , True) Then GoTo Finally + Set _PropertyGet = _ParseAddress(pvArg) + End If + Case "Sheets" + _PropertyGet = _Component.getSheets.getElementNames() + Case "Width" + If IsMissing(pvArg) Or IsEmpty(pvArg) Then + _PropertyGet = 0 + Else + If Not ScriptForge.SF_Utils._Validate(pvArg, "Range", V_STRING) Then GoTo Finally + _PropertyGet = _ParseAddress(pvArg).Width + End If + Case "XCellRange" + If IsMissing(pvArg) Or IsEmpty(pvArg) Then + Set _PropertyGet = Nothing + Else + If Not ScriptForge.SF_Utils._Validate(pvArg, "Range", V_STRING) Then GoTo Finally + Set _PropertyGet = _ParseAddress(pvArg).XCellRange + End If + Case "XSpreadsheet" + If IsMissing(pvArg) Or IsEmpty(pvArg) Then + Set _PropertyGet = Nothing + Else + If Not _ValidateSheet(pvArg, "SheetName", , True) Then GoTo Finally + Set _PropertyGet = _Component.getSheets.getByName(pvArg) + End If + Case Else + _PropertyGet = Null + End Select + +Finally: + ScriptForge.SF_Utils._ExitFunction(cstThisSub) + Exit Function +End Function ' SFDocuments.SF_Calc._PropertyGet + +REM ----------------------------------------------------------------------------- +Private Function _RangeToString(ByRef poAddress As Object) As String +''' Converts a range address to its A1 notation) + + With poAddress + _RangeToString = _GetColumnName(.StartColumn + 1) & CStr(.StartRow + 1) & ":" _ + & _GetColumnName(.EndColumn + 1) & CStr(.EndRow + 1) + End With + +End Function ' SFDocuments.SF_Calc._RangeToString + +REM ----------------------------------------------------------------------------- +Private Function _Repr() As String +''' Convert the SF_Calc instance to a readable string, typically for debugging purposes (DebugPrint ...) +''' Args: +''' Return: +''' "[DOCUMENT]: Type/File" + + _Repr = "[Calc]: " & [_Super]._FileIdent() + +End Function ' SFDocuments.SF_Calc._Repr + +REM ----------------------------------------------------------------------------- +Private Sub _RestoreSelections(ByRef pvComponent As Variant _ + , ByRef pvSelection As Variant _ + ) +''' Set the selection to a single or a multiple range +''' Does not work well when multiple selections and macro terminating in Basic IDE +''' Called by the CopyToCell and CopyToRange methods +''' Args: +''' pvComponent: should work for foreign instances as well +''' pvSelection: the stored selection done previously by Component.CurrentController.getSelection() + +Dim oCellRanges As Object ' com.sun.star.sheet.SheetCellRanges +Dim vRangeAddresses As Variant ' Array of com.sun.star.table.CellRangeAddress +Dim i As Long + +Try: + If IsArray(pvSelection) Then + Set oCellRanges = pvComponent.createInstance("com.sun.star.sheet.SheetCellRanges") + vRangeAddresses = Array() + ReDim vRangeAddresses(0 To UBound(pvSelection)) + For i = 0 To UBound(pvSelection) + vRangeAddresses(i) = pvSelection.getByIndex(i).RangeAddress + Next i + oCellRanges.addRangeAddresses(vRangeAddresses, False) + pvComponent.CurrentController.select(oCellRanges) + Else + pvComponent.CurrentController.select(pvSelection) + End If + +Finally: + Exit Sub +End Sub ' SFDocuments.SF_Calc._RestoreSelections + +REM ----------------------------------------------------------------------------- +Private Function _ValidateSheet(Optional ByRef pvSheetName As Variant _ + , Optional ByVal psArgName As String _ + , Optional ByVal pvNew As Variant _ + , Optional ByVal pvActive As Variant _ + , Optional ByVal pvOptional as Variant _ + , Optional ByVal pvNumeric As Variant _ + , Optional ByVal pvReference As Variant _ + ) As Boolean +''' Sheet designation validation function similar to the SF_Utils._ValidateXXX functions +''' Args: +''' pvSheetName: string or numeric position +''' pvNew: if True, sheet must not exist (default = False) +''' pvActive: if True, the shortcut "~" is accepted (default = False) +''' pvOptional: if True, a zero-length string is accepted (default = False) +''' pvNumeric: if True, the sheet position is accepted (default = False) +''' pvReference: if True, a sheet reference is acceptable (default = False) +''' pvNumeric and pvReference must not both be = True +''' Returns +''' True if valid. SheetName is reset to current value if = "~" +''' Exceptions +''' DUPLICATESHEETERROR A sheet with the given name exists already + +Dim vSheets As Variant ' List of sheets +Dim vTypes As Variant ' Array of accepted variable types +Dim bValid As Boolean ' Return value + +Check: + If IsMissing(pvNew) Or IsEmpty(pvNew) Then pvNew = False + If IsMissing(pvActive) Or IsEmpty(pvActive) Then pvActive = False + If IsMissing(pvOptional) Or IsEmpty(pvOptional) Then pvOptional = False + If IsMissing(pvNumeric) Or IsEmpty(pvNumeric) Then pvNumeric = False + If IsMissing(pvReference) Or IsEmpty(pvReference) Then pvReference = False + + ' Define the acceptable variable types + If pvNumeric Then + vTypes = Array(V_STRING, V_NUMERIC) + ElseIf pvReference Then + vTypes = Array(V_STRING, ScriptForge.V_OBJECT) + Else + vTypes = V_STRING + End If + If Not ScriptForge.SF_Utils._Validate(pvSheetName, psArgName, vTypes, , , Iif(pvReference, CALCREFERENCE, "")) Then GoTo Finally + bValid = False + +Try: + If VarType(pvSheetName) = V_STRING Then + If pvOptional And Len(pvSheetName) = 0 Then + ElseIf pvActive And pvSheetName = "~" Then + pvSheetName = _Component.CurrentController.ActiveSheet.Name + Else + vSheets = _Component.getSheets.getElementNames() + If pvNew Then + If ScriptForge.SF_Array.Contains(vSheets, pvSheetName) Then GoTo CatchDuplicate + Else + If Not ScriptForge.SF_Utils._Validate(pvSheetName, psArgName, V_STRING, vSheets) Then GoTo Finally + End If + End If + End If + bValid = True + +Finally: + _ValidateSheet = bValid + Exit Function +CatchDuplicate: + ScriptForge.SF_Exception.RaiseFatal(DUPLICATESHEETERROR, psArgName, pvSheetName, "Document", [_Super]._FileIdent()) + GoTo Finally +End Function ' SFDocuments.SF_Calc._ValidateSheet + +REM ============================================ END OF SFDOCUMENTS.SF_CALC +</script:module>
\ No newline at end of file diff --git a/wizards/source/sfdocuments/SF_Document.xba b/wizards/source/sfdocuments/SF_Document.xba new file mode 100644 index 000000000000..151ecd3e03d5 --- /dev/null +++ b/wizards/source/sfdocuments/SF_Document.xba @@ -0,0 +1,1010 @@ +<?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 +''' the management and several manipulations of 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_Writer, ... +''' +''' 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 +''' +''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' + +REM ================================================================== EXCEPTIONS + +Private Const DOCUMENTDEADERROR = "DOCUMENTDEADERROR" +Private Const DOCUMENTSAVEERROR = "DOCUMENTSAVEERROR" +Private Const DOCUMENTSAVEASERROR = "DOCUMENTSAVEASERROR" +Private Const DOCUMENTREADONLYERROR = "DOCUMENTREADONLYERROR" + +REM ============================================================= PRIVATE MEMBERS + +Private [Me] As Object +Private [_Parent] As Object +Private ObjectType As String ' Must be DOCUMENT +Private ServiceName As String + +' Window description +Private _Component As Object ' com.sun.star.lang.XComponent +Private _Frame As Object ' com.sun.star.comp.framework.Frame +Private _WindowName As String ' Object Name +Private _WindowTitle As String ' Only mean to identify new documents +Private _WindowFileName As String ' URL of file name +Private _DocumentType As String ' Writer, Calc, ... + +' Properties (work variables - real properties could have been set manually by user) +Private _DocumentProperties As Object ' Dictionary of document properties +Private _CustomProperties As Object ' Dictionary of custom properties + +REM ============================================================ MODULE CONSTANTS + +REM ===================================================== CONSTRUCTOR/DESCTRUCTOR + +REM ----------------------------------------------------------------------------- +Private Sub Class_Initialize() + Set [Me] = Nothing + Set [_Parent] = Nothing + ObjectType = "DOCUMENT" + ServiceName = "SFDocuments.Document" + Set _Component = Nothing + Set _Frame = Nothing + _WindowName = "" + _WindowTitle = "" + _WindowFileName = "" + _DocumentType = "" + Set _DocumentProperties = Nothing + Set _CustomProperties = Nothing +End Sub ' SFDocuments.SF_Document Constructor + +REM ----------------------------------------------------------------------------- +Private Sub Class_Terminate() + Call Class_Initialize() +End Sub ' SFDocuments.SF_Document Destructor + +REM ----------------------------------------------------------------------------- +Public Function Dispose() As Variant + Call Class_Terminate() + Set Dispose = Nothing +End Function ' SFDocuments.SF_Document Explicit Destructor + +REM ================================================================== PROPERTIES + +REM ----------------------------------------------------------------------------- +Property Get CustomProperties() As Variant +''' Returns a dictionary of all custom properties of the document + CustomProperties = _PropertyGet("CustomProperties") +End Property ' SFDocuments.SF_Document.CustomProperties + +REM ----------------------------------------------------------------------------- +Property Let CustomProperties(Optional ByVal pvCustomProperties As Variant) +''' Sets the updatable custom properties +''' The argument is a dictionary + +Dim vPropertyValues As Variant ' Array of com.sun.star.beans.PropertyValue +Dim vCustomProperties As Variant ' Alias of argument +Dim oUserdefinedProperties As Object ' Custom properties object +Dim vOldPropertyValues As Variant ' Array of (to remove) existing user defined properties +Dim oProperty As Object ' Single com.sun.star.beans.PropertyValues +Dim sProperty As String ' Property name +Dim vKeys As Variant ' Array of dictionary keys +Dim vItems As Variant ' Array of dictionary items +Dim vValue As Variant ' Value to store in property +Dim iAttribute As Integer ' com.sun.star.beans.PropertyAttribute.REMOVEABLE +Dim i As Long +Const cstThisSub = "SFDocuments.Document.setCustomProperties" +Const cstSubArgs = "CustomProperties" + + On Local Error GoTo Catch + +Check: + If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then + If Not _IsStillAlive(True) Then GoTo Finally + If Not ScriptForge.SF_Utils._Validate(pvCustomProperties, "CustomProperties", ScriptForge.V_OBJECT, , , "DICTIONARY") Then GoTo Finally + End If + +Try: + Set oUserDefinedProperties = _Component.getDocumentProperties().UserDefinedProperties + + Set vCustomProperties = pvCustomProperties ' To avoid "Object variable not set" error + With vCustomProperties + + ' All existing custom properties must first be removed to avoid type conflicts + vOldPropertyValues = oUserDefinedProperties.getPropertyValues + For Each oProperty In vOldPropertyValues + sProperty = oProperty.Name + oUserDefinedProperties.removeProperty(sProperty) + Next oProperty + + ' Insert new properties one by one after type adjustment (dates, arrays, numbers) + vKeys = .Keys + vItems = .Items + iAttribute = com.sun.star.beans.PropertyAttribute.REMOVEABLE + For i = 0 To UBound(vKeys) + If VarType(vItems(i)) = V_DATE Then + vValue = ScriptForge.SF_Utils._CDateToUnoDate(vItems(i)) + ElseIf IsArray(vItems(i)) Then + vValue = Null + ElseIf ScriptForge.SF_Utils._VarTypeExt(vItems(i)) = ScriptForge.V_NUMERIC Then + vValue = CreateUnoValue("double", vItems(i)) + Else + vValue = vItems(i) + End If + oUserDefinedProperties.addProperty(vKeys(i), iAttribute, vValue) + Next i + + ' Declare the document as changed + _Component.setModified(True) + End With + + ' Reload custom properties in current object instance + _PropertyGet("CustomProperties") + +Finally: + ScriptForge.SF_Utils._ExitFunction(cstThisSub) + Exit Property +Catch: + GoTo Finally +End Property ' SFDocuments.SF_Document.CustomProperties + +REM ----------------------------------------------------------------------------- +Property Get Description() As Variant +''' Returns the updatable document property Description + Description = _PropertyGet("Description") +End Property ' SFDocuments.SF_Document.Description + +REM ----------------------------------------------------------------------------- +Property Let Description(Optional ByVal pvDescription As Variant) +''' Sets the updatable document property Description +''' If multilined, separate lines by "\n" escape sequence or by hard breaks + +Dim sDescription As String ' Alias of pvDescription +Const cstThisSub = "SFDocuments.Document.setDescription" +Const cstSubArgs = "Description" + +Check: + If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then + If Not _IsStillAlive(True) Then GoTo Finally + If Not ScriptForge.SF_Utils._Validate(pvDescription, "Description", V_STRING) Then GoTo Finally + End If + +Try: + ' Update in UNO component object and in current instance + sDescription = Replace(pvDescription, "\n", ScriptForge.SF_String.sfNEWLINE) + _Component.DocumentProperties.Description = sDescription + If Not IsNull(_DocumentProperties) Then _DocumentProperties.ReplaceItem("Description", sdescription) + +Finally: + ScriptForge.SF_Utils._ExitFunction(cstThisSub) + Exit Property +End Property ' SFDocuments.SF_Document.Description + +REM ----------------------------------------------------------------------------- +Property Get DocumentProperties() As Variant +''' Returns a dictionary of all standard document properties, custom properties are excluded + DocumentProperties = _PropertyGet("DocumentProperties") +End Property ' SFDocuments.SF_Document.DocumentProperties + +REM ----------------------------------------------------------------------------- +Property Get DocumentType() As String +''' Returns "Base", "Calc", "Draw", ... or "Writer" + DocumentType = _PropertyGet("DocumentType") +End Property ' SFDocuments.SF_Document.DocumentType + +REM ----------------------------------------------------------------------------- +Property Get IsBase() As Boolean + IsBase = _PropertyGet("IsBase") +End Property ' SFDocuments.SF_Document.IsBase + +REM ----------------------------------------------------------------------------- +Property Get IsCalc() As Boolean + IsCalc = _PropertyGet("IsCalc") +End Property ' SFDocuments.SF_Document.IsCalc + +REM ----------------------------------------------------------------------------- +Property Get IsDraw() As Boolean + IsDraw = _PropertyGet("IsDraw") +End Property ' SFDocuments.SF_Document.IsDraw + +REM ----------------------------------------------------------------------------- +Property Get IsImpress() As Boolean + IsImpress = _PropertyGet("IsImpress") +End Property ' SFDocuments.SF_Document.IsImpress + +REM ----------------------------------------------------------------------------- +Property Get IsMath() As Boolean + IsMath = _PropertyGet("IsMath") +End Property ' SFDocuments.SF_Document.IsMath + +REM ----------------------------------------------------------------------------- +Property Get IsWriter() As Boolean + IsWriter = _PropertyGet("IsWriter") +End Property ' SFDocuments.SF_Document.IsWriter + +REM ----------------------------------------------------------------------------- +Property Get Keywords() As Variant +''' Returns the updatable document property Keywords + Keywords = _PropertyGet("Keywords") +End Property ' SFDocuments.SF_Document.Keywords + +REM ----------------------------------------------------------------------------- +Property Let Keywords(Optional ByVal pvKeywords As Variant) +''' Sets the updatable document property Keywords + +Dim vKeywords As Variant ' Alias of pvKeywords +Const cstThisSub = "SFDocuments.Document.setKeywords" +Const cstSubArgs = "Keywords" + +Check: + If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then + If Not _IsStillAlive(True) Then GoTo Finally + If Not ScriptForge.SF_Utils._Validate(pvKeywords, "Keywords", V_STRING) Then GoTo Finally + End If + +Try: + ' Update in UNO component object and in current instance + vKeywords = ScriptForge.SF_Array.TrimArray(Split(pvKeywords, ",")) + _Component.DocumentProperties.Keywords = vKeywords + If Not IsNull(_DocumentProperties) Then _DocumentProperties.ReplaceItem("Keywords", Join(vKeywords, ", ")) + +Finally: + ScriptForge.SF_Utils._ExitFunction(cstThisSub) + Exit Property +End Property ' SFDocuments.SF_Document.Keywords + +REM ----------------------------------------------------------------------------- +Property Get Readonly() As Boolean +''' Returns True if the document must not be modified + Readonly = _PropertyGet("Readonly") +End Property ' SFDocuments.SF_Document.Readonly + +REM ----------------------------------------------------------------------------- +Property Get Subject() As Variant +''' Returns the updatable document property Subject + Subject = _PropertyGet("Subject") +End Property ' SFDocuments.SF_Document.Subject + +REM ----------------------------------------------------------------------------- +Property Let Subject(Optional ByVal pvSubject As Variant) +''' Sets the updatable document property Subject + +Const cstThisSub = "SFDocuments.Document.setSubject" +Const cstSubArgs = "Subject" + +Check: + If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then + If Not _IsStillAlive(True) Then GoTo Finally + If Not ScriptForge.SF_Utils._Validate(pvSubject, "Subject", V_STRING) Then GoTo Finally + End If + +Try: + ' Update in UNO component object and in current instance + _Component.DocumentProperties.Subject = pvSubject + If Not IsNull(_DocumentProperties) Then _DocumentProperties.ReplaceItem("Subject", pvSubject) + +Finally: + ScriptForge.SF_Utils._ExitFunction(cstThisSub) + Exit Property +End Property ' SFDocuments.SF_Document.Subject + +REM ----------------------------------------------------------------------------- +Property Get Title() As Variant +''' Returns the updatable document property Title + Title = _PropertyGet("Title") +End Property ' SFDocuments.SF_Document.Title + +REM ----------------------------------------------------------------------------- +Property Let Title(Optional ByVal pvTitle As Variant) +''' Sets the updatable document property Title + +Const cstThisSub = "SFDocuments.Document.setTitle" +Const cstSubArgs = "Title" + +Check: + If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then + If Not _IsStillAlive(True) Then GoTo Finally + If Not ScriptForge.SF_Utils._Validate(pvTitle, "Title", V_STRING) Then GoTo Finally + End If + +Try: + ' Update in UNO component object and in current instance + _Component.DocumentProperties.Title = pvTitle + If Not IsNull(_DocumentProperties) Then _DocumentProperties.ReplaceItem("Title", pvTitle) + +Finally: + ScriptForge.SF_Utils._ExitFunction(cstThisSub) + Exit Property +End Property ' SFDocuments.SF_Document.Title + +REM ----------------------------------------------------------------------------- +Property Get XComponent() As Variant +''' Returns the com.sun.star.lang.XComponent UNO object representing the document + XComponent = _PropertyGet("XComponent") +End Property ' SFDocuments.SF_Document.XComponent + +REM ===================================================================== METHODS + +REM ----------------------------------------------------------------------------- +Public Function Activate() As Boolean +''' Make the current document active +''' Args: +''' Returns: +''' True if the document could be activated +''' Otherwise, there is no change in the actual user interface +''' Examples: +''' oDoc.Activate() + +Dim bActivate As Boolean ' Return value +Dim oContainer As Object ' com.sun.star.awt.XWindow +Const cstThisSub = "SFDocuments.Document.Activate" +Const cstSubArgs = "" + + If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch + bActivate = False + +Check: + ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) + If Not _IsStillAlive() Then GoTo Finally + +Try: + Set oContainer = _Frame.ContainerWindow + With oContainer + If .isVisible() = False Then .setVisible(True) + .IsMinimized = False + .setFocus() + .toFront() ' Force window change in Linux + Wait 1 ' Bypass desynchro issue in Linux + End With + bActivate = True + +Finally: + Activate = bActivate + ScriptForge.SF_Utils._ExitFunction(cstThisSub) + Exit Function +Catch: + GoTo Finally +End Function ' SFDocuments.SF_Document.Activate + +REM ----------------------------------------------------------------------------- +Public Function CloseDocument(Optional ByVal SaveAsk As Variant) As Boolean +''' Close the document. Does nothing if the document is already closed +''' regardless of how the document was closed, manually or by program +''' Args: +''' SaveAsk: If True (default), the user is invited to confirm or not the writing of the changes on disk +''' No effect if the document was not modified +''' Returns: +''' False if the user declined to close +''' Examples: +''' If oDoc.CloseDocument() Then +''' ' ... + +Dim bClosed As Boolean ' return value +Dim oDispatch ' com.sun.star.frame.DispatchHelper +Const cstThisSub = "SFDocuments.Document.CloseDocument" +Const cstSubArgs = "[SaveAsk=True]" + + If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch + bClosed = False + +Check: + If IsMissing(SaveAsk) Or IsEmpty(SaveAsk) Then SaveAsk = True + If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then + If Not _IsStillAlive() Then GoTo Finally + If Not ScriptForge.SF_Utils._Validate(SaveAsk, "SaveAsk", V_BOOLEAN) Then GoTo Finally + End If + +Try: + If SaveAsk And _Component.IsModified Then ' Execute closure with the File/Close menu command + Activate() + RunCommand("CloseDoc") + bClosed = _IsStillAlive(, False) ' Do not raise error + Else + _Frame.close(True) + _Frame.dispose() + bClosed = True + End If + +Finally: + If bClosed Then Dispose() + CloseDocument = bClosed + ScriptForge.SF_Utils._ExitFunction(cstThisSub) + Exit Function +Catch: + GoTo Finally +End Function ' SFDocuments.SF_Document.CloseDocument + +REM ----------------------------------------------------------------------------- +Public Function 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 Model service as an array + + Methods = Array( _ + "Activate" _ + , "CloseDocument" _ + , "RunCommand" _ + , "Save" _ + , "SaveAs" _ + , "SaveCopyAs" _ + ) + +End Function ' SFDocuments.SF_Document.Methods + +REM ----------------------------------------------------------------------------- +Public Function Properties() As Variant +''' Return the list or properties of the Timer class as an array + + Properties = Array( _ + "CustomProperties" _ + , "Description" _ + , "DocumentProperties" _ + , "DocumentType" _ + , "IsBase" _ + , "IsCalc" _ + , "IsDraw " _ + , "IsImpress" _ + , "IsMath" _ + , "IsWriter" _ + , "Keywords" _ + , "Readonly" _ + , "Subject" _ + , "Title" _ + , "XComponent" _ + ) + +End Function ' SFDocuments.SF_Document.Properties + +REM ----------------------------------------------------------------------------- +Public Sub RunCommand(Optional ByVal Command As Variant) +''' Run on the document the given menu command. The command is executed without arguments +''' A few typical commands: +''' Save, SaveAs, ExportToPDF, SetDocumentProperties, Undo, Copy, Paste, ... +''' Dozens can be found in the directory $install/share/config/soffice.cfg/modules +''' Args: +''' Command: Case-sensitive. The command itself is not checked. +''' If nothing happens, then the command is probably wrong +''' Returns: +''' Examples: +''' oDoc.RunCommand("About") + +Dim oDispatch ' com.sun.star.frame.DispatchHelper +Const cstThisSub = "SFDocuments.Document.RunCommand" +Const cstSubArgs = "Command" + + If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch + +Check: + If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then + If Not _IsStillAlive() Then GoTo Finally + If Not ScriptForge.SF_Utils._Validate(Command, "Command", V_STRING) Then GoTo Finally + End If + +Try: + Set oDispatch = ScriptForge.SF_Utils._GetUNOService("DispatchHelper") + oDispatch.executeDispatch(_Frame, ".uno:" & Command, "", 0, Array()) + +Finally: + ScriptForge.SF_Utils._ExitFunction(cstThisSub) + Exit Sub +Catch: + GoTo Finally +End Sub ' SFDocuments.SF_Document.RunCommand + +REM ----------------------------------------------------------------------------- +Public Function Save() As Boolean +''' Store the document to the file location from which it was loaded +''' Ignored if the document was not modified +''' Args: +''' Returns: +''' False if the document could not be saved +''' Exceptions: +''' DOCUMENTSAVEERROR The file has been opened readonly or was opened as new and was not yet saved +''' Examples: +''' If Not oDoc.Save() Then +''' ' ... + +Dim bSaved As Boolean ' return value +Const cstThisSub = "SFDocuments.Document.Save" +Const cstSubArgs = "" + + If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch + bSaved = False + +Check: + ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) + If Not _IsStillAlive() Then GoTo Finally + bSaved = False + +Try: + With _Component + If .isReadonly() Or Not .hasLocation() Then GoTo CatchReadonly + If .IsModified() Then + .store() + bSaved = True + End If + End With + +Finally: + Save = bSaved + ScriptForge.SF_Utils._ExitFunction(cstThisSub) + Exit Function +Catch: + GoTo Finally +CatchReadonly: + ScriptForge.SF_Exception.RaiseFatal(DOCUMENTSAVEERROR, "FileName", _FileIdent()) + GoTo Finally +End Function ' SFDocuments.SF_Document.Save + +REM ----------------------------------------------------------------------------- +Public Function SaveAs(Optional ByVal FileName As Variant _ + , Optional ByVal Overwrite As Variant _ + , Optional ByVal Password As Variant _ + , Optional ByVal FilterName As Variant _ + , Optional ByVal FilterOptions As Variant _ + ) As Boolean +''' Store the document to the given file location +''' The new location becomes the new file name on which simple Save method calls will be applied +''' Args: +''' FileName: Identifies the file where to save. It must follow the SF_FileSystem.FileNaming notation +''' Overwrite: True if the destination file may be overwritten (default = False) +''' Password: Use to protect the document +''' FilterName: the name of a filter that should be used for saving the document +''' If present, the filter must exist +''' FilterOptions: an optional string of options associated with the filter +''' Returns: +''' False if the document could not be saved +''' Exceptions: +''' DOCUMENTSAVEASERROR The destination has its readonly attribute set or overwriting rejected +''' Examples: +''' oDoc.SaveAs("C:\Me\Copy2.odt", Overwrite := True) + +Dim bSaved As Boolean ' return value +Dim oFilterFactory As Object ' com.sun.star.document.FilterFactory +Dim oSfa As Object ' com.sun.star.ucb.SimpleFileAccess +Dim sFile As String ' Alias of FileName +Dim vProperties As Variant ' Array of com.sun.star.beans.PropertyValue +Dim FSO As Object ' SF_FileSystem +Const cstThisSub = "SFDocuments.Document.SaveAs" +Const cstSubArgs = "FileName, [Overwrite=False], [Password=""""], [FilterName=""""], [FilterOptions=""""]" + + If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo CatchError + bSaved = False + +Check: + If IsMissing(Overwrite) Or IsEmpty(Overwrite) Then Overwrite = False + If IsMissing(Password) Or IsEmpty(Password) Then Password = "" + If IsMissing(FilterName) Or IsEmpty(FilterName) Then FilterName = "" + If IsMissing(FilterOptions) Or IsEmpty(FilterOptions) Then FilterOptions = "" + + If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then + If Not _IsStillAlive() Then GoTo Finally + If Not SF_Utils._ValidateFile(FileName, "FileName") Then GoTo Finally + If Not SF_Utils._Validate(Overwrite, "Overwrite", 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", 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 ----------------------------------------------------------------------------- +Private Function SetProperty(Optional ByVal psProperty As String _ + , Optional ByVal pvValue As Variant _ + ) As Boolean +''' Set the new value of the named property +''' Args: +''' psProperty: the name of the property +''' pvValue: the new value of the given property +''' Returns: +''' True if successful + +Dim bSet As Boolean ' Return value +Static oSession As Object ' Alias of SF_Session +Dim cstThisSub As String +Const cstSubArgs = "Value" + + If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch + bSet = False + + cstThisSub = "SFDocuments.Document.set" & psProperty + If IsMissing(pvValue) Then pvValue = Empty + 'ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) ' Validation done in Property Lets + + If IsNull(oSession) Then Set oSession = ScriptForge.SF_Services.CreateScriptService("Session") + bSet = True + Select Case UCase(psProperty) + Case UCase("CustomProperties") + CustomProperties = pvValue + Case UCase("Description") + Description = pvValue + Case UCase("Keywords") + Keywords = pvValue + Case UCase("Subject") + Subject = pvValue + Case UCase("Title") + Title = pvValue + Case Else + bSet = False + End Select + +Finally: + SetProperty = bSet + 'ScriptForge.SF_Utils._ExitFunction(cstThisSub) + Exit Function +Catch: + GoTo Finally +End Function ' SFDocuments.SF_Document.SetProperty + +REM =========================================================== PRIVATE FUNCTIONS + +REM ----------------------------------------------------------------------------- +Private Function _FileIdent() As String +''' Returns a file identification from the information that is currently available +''' Useful e.g. for display in error messages + + _FileIdent = Iif(Len(_WindowFileName) > 0, SF_FileSystem._ConvertFromUrl(_WindowFileName), _WindowTitle) + +End Function ' SFDocuments.SF_Document._FileIdent + +REM ----------------------------------------------------------------------------- +Private Function _IsStillAlive(Optional ByVal pbForUpdate As Boolean _ + , Optional ByVal pbError As Boolean _ + ) As Boolean +''' Returns True if the document has not been closed manually or incidentally since the last use +''' If dead the actual instance is disposed. The execution is cancelled when pbError = True (default) +''' Args: +''' pbForUpdate: if True (default = False), check additionally if document is open for editing +''' pbError: if True (default), raise a fatal error + +Dim bAlive As Boolean ' Return value +Dim sFileName As String ' File identification used to display error message + + On Local Error GoTo Catch ' Anticipate DisposedException errors or alike + If IsMissing(pbForUpdate) Then pbForUpdate = False + If IsMissing(pbError) Then pbError = True + +Try: + ' Check existence of document + bAlive = Not IsNull(_Frame) + If bAlive Then bAlive = Not IsNull(_Component) + If bAlive Then bAlive = Not IsNull(_Component.CurrentController) + + ' Check document is not read only + If bAlive And pbForUpdate Then + If _Component.isreadonly() Then GoTo CatchReadonly + End If + +Finally: + _IsStillAlive = bAlive + Exit Function +Catch: + bAlive = False + On Error GoTo 0 + sFileName = _FileIdent() + Dispose() + If pbError Then ScriptForge.SF_Exception.RaiseFatal(DOCUMENTDEADERROR, sFileName) + GoTo Finally +CatchReadonly: + bAlive = False + If pbError Then ScriptForge.SF_Exception.RaiseFatal(DOCUMENTREADONLYERROR, "Document", _FileIdent()) + GoTo Finally +End Function ' SFDocuments.SF_Document._IsStillAlive + +REM ----------------------------------------------------------------------------- +Private Sub _LoadDocumentProperties() +''' Create dictionary with document properties as entries/ Custom properties are excluded +''' Document is presumed still alive +''' Special values: +''' Only valid dates are taken +''' Statistics are exploded in subitems. Subitems are specific to document type +''' Keywords are joined +''' Language is aligned on L10N convention la-CO + +Dim oProperties As Object ' Document properties +Dim vNamedValue As Variant ' com.sun.star.beans.NamedValue + + If IsNull(_DocumentProperties) Then + Set oProperties = _Component.getDocumentProperties + Set _DocumentProperties = CreateScriptService("Dictionary") + With _DocumentProperties + .Add("Author", oProperties.Author) + .Add("AutoloadSecs", oProperties.AutoloadSecs) + .Add("AutoloadURL", oProperties.AutoloadURL) + If oProperties.CreationDate.Year > 0 Then .Add("CreationDate", CDateFromUnoDateTime(oProperties.CreationDate)) + .Add("DefaultTarget", oProperties.DefaultTarget) + .Add("Description", oProperties.Description) ' The description can be multiline + ' DocumentStatistics : number and names of statistics depend on document type + For Each vNamedValue In oProperties.DocumentStatistics + .Add(vNamedValue.Name, vNamedValue.Value) + Next vNamedValue + .Add("EditingDuration", oProperties.EditingDuration) + .Add("Generator", oProperties.Generator) + .Add("Keywords", Join(oProperties.Keywords, ", ")) + .Add("Language", oProperties.Language.Language & Iif(Len(oProperties.Language.Country) > 0, "-" & oProperties.Language.Country, "")) + If oProperties.ModificationDate.Year > 0 Then .Add("ModificationDate", CDateFromUnoDateTime(oProperties.ModificationDate)) + If oProperties.PrintDate.Year > 0 Then .Add("PrintDate", CDateFromUnoDateTime(oProperties.PrintDate)) + .Add("PrintedBy", oProperties.PrintedBy) + .Add("Subject", oProperties.Subject) + If oProperties.TemplateDate.Year > 0 Then .Add("TemplateDate", CDateFromUnoDateTime(oProperties.TemplateDate)) + .Add("TemplateName", oProperties.TemplateName) + .Add("TemplateURL", oProperties.TemplateURL) + .Add("Title", oProperties.Title) + End With + End If + +End Sub ' SFDocuments.SF_Document._LoadDocumentProperties + +REM ----------------------------------------------------------------------------- +Private Function _PropertyGet(Optional ByVal psProperty As String) As Variant +''' Return the value of the named property +''' Args: +''' psProperty: the name of the property + +Dim oProperties As Object ' Document or Custom properties +Dim cstThisSub As String +Const cstSubArgs = "" + + _PropertyGet = False + + Select Case _DocumentType + Case "Calc" : cstThisSub = "SFDocuments.SF_" & _DocumentType & ".get" & psProperty + Case Else : cstThisSub = "SFDocuments.SF_Document.get" & psProperty + End Select + ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) + If Not _IsStillAlive() Then GoTo Finally + + Select Case psProperty + Case "CustomProperties" + _CustomProperties = CreateScriptService("Dictionary") ' Always reload as updates could have been done manually by user + _CustomProperties.ImportFromPropertyValues(_Component.getDocumentProperties().UserDefinedProperties.getPropertyValues) + _PropertyGet = _CustomProperties + Case "Description" + _PropertyGet = _Component.DocumentProperties.Description + Case "DocumentProperties" + _LoadDocumentProperties() ' Always reload as updates could have been done manually by user + Set _PropertyGet = _DocumentProperties + Case "DocumentType" + _PropertyGet = _DocumentType + Case "IsBase", "IsCalc", "IsDraw", "IsImpress", "IsMath", "IsWriter" + _PropertyGet = ( Mid(psProperty, 3) = _DocumentType ) + Case "Keywords" + _PropertyGet = Join(_Component.DocumentProperties.Keywords, ", ") + Case "Readonly" + _PropertyGet = _Component.isReadonly() + Case "Subject" + _PropertyGet = _Component.DocumentProperties.Subject + Case "Title" + _PropertyGet = _Component.DocumentProperties.Title + Case "XComponent" + Set _PropertyGet = _Component + Case Else + _PropertyGet = Null + End Select + +Finally: + ScriptForge.SF_Utils._ExitFunction(cstThisSub) + Exit Function +End Function ' SFDocuments.SF_Document._PropertyGet + +REM ----------------------------------------------------------------------------- +Private Function _Repr() As String +''' Convert the SF_Document instance to a readable string, typically for debugging purposes (DebugPrint ...) +''' Args: +''' Return: +''' "[DOCUMENT]: Type - File" + + _Repr = "[Document]: " & _DocumentType & " - " & _FileIdent() + +End Function ' SFDocuments.SF_Document._Repr + +REM ============================================ END OF SFDOCUMENTS.SF_DOCUMENT +</script:module>
\ No newline at end of file diff --git a/wizards/source/sfdocuments/SF_Register.xba b/wizards/source/sfdocuments/SF_Register.xba new file mode 100644 index 000000000000..40f327bb0d41 --- /dev/null +++ b/wizards/source/sfdocuments/SF_Register.xba @@ -0,0 +1,198 @@ +<?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_Register" 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 Explicit + +''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' +''' SF_Register +''' =========== +''' The ScriptForge framework includes +''' the master ScriptForge library +''' a number of "associated" libraries SF* +''' any user/contributor extension wanting to fit into the framework +''' +''' The main methods in this module allow the current library to cling to ScriptForge +''' - RegisterScriptServices +''' Register the list of services implemented by the current library +''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' + +REM ================================================================== EXCEPTIONS + +REM ============================================================== PUBLIC METHODS + +REM ----------------------------------------------------------------------------- +Public Sub RegisterScriptServices() As Variant +''' Register into ScriptForge the list of the services implemented by the current library +''' Each library pertaining to the framework must implement its own version of this method +''' +''' It consists in successive calls to the RegisterService() and RegisterEventManager() methods +''' with 2 arguments: +''' ServiceName: the name of the service as a case-insensitive string +''' ServiceReference: the reference as an object +''' If the reference refers to a module, then return the module as an object: +''' GlobalScope.Library.Module +''' If the reference is a class instance, then return a string referring to the method +''' containing the New statement creating the instance +''' "libraryname.modulename.function" + + With GlobalScope.ScriptForge.SF_Services + .RegisterService("Document", "SFDocuments.SF_Register._NewDocument") ' Reference to the function initializing the service + .RegisterService("Calc", "SFDocuments.SF_Register._NewDocument") ' Same references, distinction is made inside the function + .RegisterService("Base", "SFDocuments.SF_Register._NewDocument") ' Same references, distinction is made inside the function + .RegisterEventManager("DocumentEvent", "SFDocuments.SF_Register._EventManager") ' Reference to the events manager + 'TODO + End With + +End Sub ' SFDocuments.SF_Register.RegisterScriptServices + +REM =========================================================== PRIVATE FUNCTIONS + +REM ----------------------------------------------------------------------------- +Public Function _EventManager(Optional ByRef pvArgs As Variant) As Object +''' Returns a Document or Calc object corresponding with the active component +''' which triggered the event in argument +''' This method should be triggered only thru the invocation of CreateScriptService +''' Args: +''' pvEvent: com.sun.star.document.DocumentEvent +''' Returns: +''' the output of a Document, Calc, ... service or Nothing +''' Example: +''' Sub TriggeredByEvent(ByRef poEvent As Object) +''' Dim oDoc As Object +''' Set oDoc = CreateScriptService("SFDocuments.DocumentEvent", poEvent) +''' If Not IsNull(oDoc) Then +''' ' ... (a valid document has been identified) +''' End Sub + +Dim oSource As Object ' Return value +Dim vEvent As Variant ' Alias of pvArgs(0) + + ' Never abort while an event is processed + If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Finally + Set oSource = Nothing + +Check: + If IsMissing(pvArgs) Or IsEmpty(pvArgs) Then pvArgs = Array() + If UBound(pvArgs) >= 0 Then vEvent = pvArgs(0) Else Set vEvent = Empty + If VarType(vEvent) <> ScriptForge.V_OBJECT Then GoTo Finally + +Try: + If ScriptForge.SF_Session.UnoObjectType(vEvent) = "com.sun.star.document.DocumentEvent" Then + If ScriptForge.SF_Session.UnoObjectType(vEvent.Source) = "SwXTextDocument" Then + Set oSource = SF_Register._NewDocument(vEvent.Source) + End If + End If + +Finally: + Set _EventManager = oSource + Exit Function +End Function ' SFDocuments.SF_Documents._EventManager + +REM ----------------------------------------------------------------------------- +Public Function _NewDocument(Optional ByVal pvArgs As Variant) As Object +''' Create a new instance of the (super) SF_Document class or of one of its subclasses (SF_Calc, ...) +' Args: +''' WindowName: see the definition of WindowName in the description of the UI service +''' If absent, the document is presumed to be in the active window +''' If WindowName is an object, it must be a component +''' (com.sun.star.lang.XComponent or com.sun.star.comp.dba.ODatabaseDocument) +''' Returns: the instance or Nothing + +Dim oDocument As Object ' Return value +Dim oSuperDocument As Object ' Companion superclass document +Dim vWindowName As Variant ' Alias of pvArgs(0) +Dim oEnum As Object ' com.sun.star.container.XEnumeration +Dim oComp As Object ' com.sun.star.lang.XComponent +Dim vWindow As Window ' A single component +Dim oUi As Object ' "UI" service +Dim bFound As Boolean ' True if the document is found on the desktop + + If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch + +Check: + If IsMissing(pvArgs) Or IsEmpty(pvArgs) Then pvArgs = Array() + If Not IsArray(pvArgs) Then pvArgs = Array(pvArgs) ' Needed when _NewDocument called from _EventManager + If UBound(pvArgs) >= 0 Then vWindowName = pvArgs(0) Else vWindowName = "" + If Not ScriptForge.SF_Utils._Validate(vWindowName, "WindowName", Array(V_STRING, ScriptForge.V_OBJECT)) Then GoTo Finally + Set oDocument = Nothing + +Try: + Set oUi = ScriptForge.SF_Register.CreateScriptService("UI") + Select Case VarType(vWindowName) + Case V_STRING + If Len(vWindowName) > 0 Then + bFound = False + Set oEnum = StarDesktop.Components().createEnumeration + Do While oEnum.hasMoreElements + Set oComp = oEnum.nextElement + vWindow = oUi._IdentifyWindow(oComp) + With vWindow + ' Does the current window match the argument ? + If (Len(.WindowFileName) > 0 And .WindowFileName = ScriptForge.SF_FileSystem._ConvertToUrl(vWindowName)) _ + Or (Len(.WindowName) > 0 And .WindowName = vWindowName) _ + Or (Len(.WindowTitle) > 0 And .WindowTitle = vWindowName) Then + bFound = True + Exit Do + End If + End With + Loop + Else + bFound = True + vWindow = oUi._IdentifyWindow(StarDesktop.CurrentComponent) + End If + Case ScriptForge.V_OBJECT ' com.sun.star.lang.XComponent + bFound = True + vWindow = oUi._IdentifyWindow(vWindowName) + End Select + + If bFound And Not IsNull(vWindow.Frame) And Len(vWindow.DocumentType) > 0 Then + ' Create the right subclass and associate to it a new instance of the superclass + Select Case vWindow.DocumentType + Case "Base" + Set oDocument = New SF_Base + Set oSuperDocument = New SF_Document + Set oDocument.[_Super] = oSuperDocument ' Now both super and subclass are twinned + Case "Calc" + Set oDocument = New SF_Calc + Set oSuperDocument = New SF_Document + Set oDocument.[_Super] = oSuperDocument ' Now both super and subclass are twinned + Case Else ' Only superclass + Set oDocument = New SF_Document + Set oSuperDocument = oDocument + End Select + With oDocument ' Initialize attributes of subclass + Set .[Me] = oDocument + Set ._Component = vWindow.Component + ' Initialize specific attributes + Select Case vWindow.DocumentType + Case "Base" + Set ._DataSource = ._Component.DataSource + Case Else + End Select + End With + With oSuperDocument ' Initialize attributes of superclass + Set .[Me] = oSuperDocument + Set ._Component = vWindow.Component + Set ._Frame = vWindow.Frame + ._WindowName = vWindow.WindowName + ._WindowTitle = vWindow.WindowTitle + ._WindowFileName = vWindow.WindowFileName + ._DocumentType = vWindow.DocumentType + End With + End If + +Finally: + Set _NewDocument = oDocument + Exit Function +Catch: + GoTo Finally +End Function ' SFDocuments.SF_Register._NewDocument + +REM ============================================== END OF SFDOCUMENTS.SF_REGISTER +</script:module>
\ No newline at end of file diff --git a/wizards/source/sfdocuments/__License.xba b/wizards/source/sfdocuments/__License.xba new file mode 100644 index 000000000000..eddcd8214951 --- /dev/null +++ b/wizards/source/sfdocuments/__License.xba @@ -0,0 +1,26 @@ +<?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="__License" script:language="StarBasic" script:moduleType="normal"> +''' Copyright 2019-2020 Jean-Pierre LEDURE, Jean-François NIFENECKER, Alain ROMEDENNE + +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 ======================================================================================================================= + +''' ScriptForge is distributed in the hope that it will be useful, +''' but WITHOUT ANY WARRANTY; without even the implied warranty of +''' MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. + +''' ScriptForge is free software; you can redistribute it and/or modify it under the terms of either (at your option): + +''' 1) The Mozilla Public License, v. 2.0. If a copy of the MPL was not +''' distributed with this file, you can obtain one at http://mozilla.org/MPL/2.0/ . + +''' 2) The GNU Lesser General Public License as published by +''' the Free Software Foundation, either version 3 of the License, or +''' (at your option) any later version. If a copy of the LGPL was not +''' distributed with this file, see http://www.gnu.org/licenses/ . + +</script:module>
\ No newline at end of file diff --git a/wizards/source/sfdocuments/dialog.xlb b/wizards/source/sfdocuments/dialog.xlb new file mode 100644 index 000000000000..62e84ea5c08d --- /dev/null +++ b/wizards/source/sfdocuments/dialog.xlb @@ -0,0 +1,3 @@ +<?xml version="1.0" encoding="UTF-8"?> +<!DOCTYPE library:library PUBLIC "-//OpenOffice.org//DTD OfficeDocument 1.0//EN" "library.dtd"> +<library:library xmlns:library="http://openoffice.org/2000/library" library:name="SFDocuments" library:readonly="false" library:passwordprotected="false"/>
\ No newline at end of file diff --git a/wizards/source/sfdocuments/script.xlb b/wizards/source/sfdocuments/script.xlb new file mode 100644 index 000000000000..82a939306752 --- /dev/null +++ b/wizards/source/sfdocuments/script.xlb @@ -0,0 +1,9 @@ +<?xml version="1.0" encoding="UTF-8"?> +<!DOCTYPE library:library PUBLIC "-//OpenOffice.org//DTD OfficeDocument 1.0//EN" "library.dtd"> +<library:library xmlns:library="http://openoffice.org/2000/library" library:name="SFDocuments" library:readonly="false" library:passwordprotected="false"> + <library:element library:name="__License"/> + <library:element library:name="SF_Document"/> + <library:element library:name="SF_Calc"/> + <library:element library:name="SF_Register"/> + <library:element library:name="SF_Base"/> +</library:library>
\ No newline at end of file |