wizards/source/sfdocuments/SF_Base.xba | 464 ++++
wizards/source/sfdocuments/SF_Calc.xba | 2843 +++++++++++++++++++++++++++++
wizards/source/sfdocuments/SF_Document.xba | 1010 ++++++++++
wizards/source/sfdocuments/SF_Register.xba | 198 ++
wizards/source/sfdocuments/__License.xba | 26
wizards/source/sfdocuments/dialog.xlb | 3
wizards/source/sfdocuments/script.xlb | 9
7 files changed, 4553 insertions(+)
New commits:
commit cdedc00ff579980c73b3cdb5fee0c78c1e111361
Author: Jean-Pierre Ledure <j...@ledure.be>
AuthorDate: Thu Nov 5 16:28:52 2020 +0100
Commit: Jean-Pierre Ledure <j...@ledure.be>
CommitDate: Thu Nov 5 16:28:52 2020 +0100
ScriptForge - SFDocuments library
Additional "LibreOffice Macros & Dialogs" library
Change-Id: I1eadae02d2bbd5d549d9a5bbcec2b83682c7c2ab
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()
... etc. - the rest is truncated
_______________________________________________
Libreoffice-commits mailing list
libreoffice-comm...@lists.freedesktop.org
https://lists.freedesktop.org/mailman/listinfo/libreoffice-commits
