407b53dd22
Next methods are introduced in SF_Session:
- GetPDFExportOptions to extract a dictionary of the
40+ existing options for PDF export
- SetPDFExportOptions to update the existing options
When applied the options are permanent also for user manual exports
Those methods are not available in Python.
Next method to export a document to PDF:
- ExportAsPDF: it uses the options set above and/or takes
next specific and transitional options:
pages, password, watermark
This method is implemented for use from Basic and Python
Change-Id: Ic5c4190cff579e62137930f422638aad98e61a16
Reviewed-on: https://gerrit.libreoffice.org/c/core/+/120740
Tested-by: Jean-Pierre Ledure <jp@ledure.be>
Tested-by: Jenkins
Reviewed-by: Jean-Pierre Ledure <jp@ledure.be>
3232 lines
No EOL
141 KiB
XML
3232 lines
No EOL
141 KiB
XML
<?xml version="1.0" encoding="UTF-8"?>
|
|
<!DOCTYPE script:module PUBLIC "-//OpenOffice.org//DTD OfficeDocument 1.0//EN" "module.dtd">
|
|
<script:module xmlns:script="http://openoffice.org/2000/script" script:name="SF_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
|
|
''' managing and manipulating 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_Base, ...
|
|
'''
|
|
''' 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
|
|
'''
|
|
''' Detailed user documentation:
|
|
''' https://help.libreoffice.org/latest/en-US/text/sbasic/shared/03/sf_calc.html?DbPAR=BASIC
|
|
'''
|
|
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
|
|
|
|
REM ================================================================== EXCEPTIONS
|
|
|
|
Private Const UNKNOWNFILEERROR = "UNKNOWNFILEERROR"
|
|
Private Const BASEDOCUMENTOPENERROR = "BASEDOCUMENTOPENERROR"
|
|
Private Const CALCADDRESSERROR = "CALCADDRESSERROR"
|
|
Private Const DUPLICATESHEETERROR = "DUPLICATESHEETERROR"
|
|
Private Const OFFSETADDRESSERROR = "OFFSETADDRESSERROR"
|
|
Private Const CALCFORMNOTFOUNDERROR = "CALCFORMNOTFOUNDERROR"
|
|
Private Const DUPLICATECHARTERROR = "DUPLICATECHARTERROR"
|
|
|
|
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"
|
|
ServiceName As String ' Must be "SFDocuments.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 columns in a sheet
|
|
Private Const MAXROWS = 2^20 ' Max number of rows in a sheet
|
|
|
|
Private Const CALCREFERENCE = "SF_CalcReference" ' Object type of _Address
|
|
Private Const SERVICEREFERENCE = "SFDocuments.CalcReference"
|
|
' Service name of _Address (used in Python)
|
|
|
|
Private Const ISCALCFORM = 2 ' Form is stored in a Calc document
|
|
|
|
REM ====================================================== CONSTRUCTOR/DESTRUCTOR
|
|
|
|
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 _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 _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 Function Charts(Optional ByVal SheetName As Variant _
|
|
, Optional ByVal ChartName As Variant _
|
|
) As Variant
|
|
''' Return either the list of charts present in the given sheet or a chart object
|
|
''' Args:
|
|
''' SheetName: The name of an existing sheet
|
|
''' ChartName: The user-defined name of the targeted chart or the zero-length string
|
|
''' Returns:
|
|
''' When ChartName = "", return the list of the charts present in the sheet,
|
|
''' otherwise, return a new chart service instance
|
|
''' Examples:
|
|
''' Dim oChart As Object
|
|
''' Set oChart = oDoc.Charts("SheetX", "myChart")
|
|
|
|
Dim vCharts As Variant ' Return value when array of chart names
|
|
Dim oChart As Object ' Return value when new chart instance
|
|
Dim oSheet As Object ' Alias of SheetName as reference
|
|
Dim oDrawPage As Object ' com.sun.star.drawing.XDrawPage
|
|
Dim oNextShape As Object ' com.sun.star.drawing.XShape
|
|
Dim sChartName As String ' Some chart name
|
|
Dim lCount As Long ' Counter for charts among all drawing objects
|
|
Dim i As Long
|
|
Const cstChartShape = "com.sun.star.drawing.OLE2Shape"
|
|
|
|
Const cstThisSub = "SFDocuments.Calc.Charts"
|
|
Const cstSubArgs = "SheetName, [ChartName=""""]"
|
|
|
|
If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
|
|
vCharts = Array()
|
|
|
|
Check:
|
|
If IsMissing(ChartName) Or IsEmpty(ChartName) Then ChartName = ""
|
|
If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
|
|
If Not _IsStillAlive(True) Then GoTo Finally
|
|
If Not _ValidateSheet(SheetName, "SheetName", , True) Then GoTo Finally
|
|
If Not ScriptForge.SF_Utils._Validate(ChartName, "ChartName", V_STRING) Then GoTo Finally
|
|
End If
|
|
|
|
Try:
|
|
' Because the user can change it constantly, the list of valid charts has to be rebuilt at each time
|
|
' Explore charts starting from the draw page
|
|
Set oSheet = _Component.getSheets.getByName(SheetName)
|
|
Set oDrawPage = oSheet.getDrawPage()
|
|
vCharts = Array()
|
|
Set oChart = Nothing
|
|
lCount = -1
|
|
For i = 0 To oDrawPage.Count - 1
|
|
Set oNextShape = oDrawPage.getByIndex(i)
|
|
if oNextShape.supportsService(cstChartShape) Then ' Ignore other shapes
|
|
sChartName = oNextShape.Name ' User-defined name
|
|
If Len(sChartName) = 0 Then sChartName = oNextShape.PersistName ' Internal name
|
|
' Is chart found ?
|
|
If Len(ChartName) > 0 Then
|
|
If ChartName = sChartName Then
|
|
Set oChart = New SF_Chart
|
|
With oChart
|
|
Set .[Me] = oChart
|
|
Set .[_Parent] = [Me]
|
|
._SheetName = SheetName
|
|
._DrawIndex = i
|
|
._ChartName = ChartName
|
|
._PersistentName = oNextShape.PersistName
|
|
Set ._Shape = oNextShape
|
|
Set ._Chart = oSheet.getCharts().getByName(._PersistentName)
|
|
Set ._ChartObject = ._Chart.EmbeddedObject
|
|
Set ._Diagram = ._ChartObject.Diagram
|
|
End With
|
|
Exit For
|
|
End If
|
|
End If
|
|
' Build stack of chart names
|
|
lCount = lCount + 1
|
|
If UBound(vCharts) < 0 Then
|
|
vCharts = Array(sChartName)
|
|
Else
|
|
ReDim Preserve vCharts(0 To UBound(vCharts) + 1)
|
|
vCharts(lCount) = sChartName
|
|
End If
|
|
End If
|
|
Next i
|
|
|
|
' Raise error when chart not found
|
|
If Len(ChartName) > 0 And IsNull(oChart) Then
|
|
If Not ScriptForge.SF_Utils._Validate(ChartName, "ChartName", V_STRING, vCharts) Then GoTo Finally
|
|
End If
|
|
|
|
Finally:
|
|
If Len(ChartName) = 0 Then Charts = vCharts Else Set Charts = oChart
|
|
ScriptForge.SF_Utils._ExitFunction(cstThisSub)
|
|
Exit Function
|
|
Catch:
|
|
GoTo Finally
|
|
End Function ' SFDocuments.SF_Calc.Charts
|
|
|
|
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 _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 _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 _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 _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
|
|
''' 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 _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 a range of cells, 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 _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 _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 CreateChart(Optional ByVal ChartName As Variant _
|
|
, Optional ByVal SheetName As Variant _
|
|
, Optional ByVal Range As Variant _
|
|
, Optional ColumnHeader As Variant _
|
|
, Optional RowHeader As Variant _
|
|
) As Variant
|
|
''' Return a new chart instance initialized with default values
|
|
''' Args:
|
|
''' ChartName: The user-defined name of the new chart
|
|
''' SheetName: The name of an existing sheet
|
|
''' Range: the cell or the range as a string that should be drawn
|
|
''' ColumnHeader: when True, the topmost row of the range will be used to set labels for the category axis or the legend.
|
|
''' Default = False
|
|
''' RowHeader: when True, the leftmost column of the range will be used to set labels for the category axis or the legend.
|
|
''' Default = False
|
|
''' Returns:
|
|
''' A new chart service instance
|
|
''' Exceptions:
|
|
''' DUPLICATECHARTERROR A chart with the same name exists already in the given sheet
|
|
''' Examples:
|
|
''' Dim oChart As Object
|
|
''' Set oChart = oDoc.CreateChart("myChart", "SheetX", "A1:C8", ColumnHeader := True)
|
|
|
|
Dim oChart As Object ' Return value
|
|
Dim vCharts As Variant ' List of pre-existing charts
|
|
Dim oSheet As Object ' Alias of SheetName as reference
|
|
Dim oRange As Object ' Alias of Range
|
|
Dim oRectangle as new com.sun.star.awt.Rectangle ' Simple shape
|
|
|
|
Const cstThisSub = "SFDocuments.Calc.CreateChart"
|
|
Const cstSubArgs = "ChartName, SheetName, Range, [ColumnHeader=False], [RowHeader=False]"
|
|
|
|
If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
|
|
Set oChart = Nothing
|
|
|
|
Check:
|
|
If IsMissing(RowHeader) Or IsEmpty(RowHeader) Then Rowheader = False
|
|
If IsMissing(ColumnHeader) Or IsEmpty(ColumnHeader) Then ColumnHeader = False
|
|
If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
|
|
If Not _IsStillAlive(True) Then GoTo Finally
|
|
If Not ScriptForge.SF_Utils._Validate(ChartName, "ChartName", V_STRING) Then GoTo Finally
|
|
If Not _ValidateSheet(SheetName, "SheetName", , True) Then GoTo Finally
|
|
If Not ScriptForge.SF_Utils._Validate(Range, "Range", V_STRING) Then GoTo Finally
|
|
If Not ScriptForge.SF_Utils._Validate(ColumnHeader, "ColumnHeader", ScriptForge.V_BOOLEAN) Then GoTo Finally
|
|
If Not ScriptForge.SF_Utils._Validate(RowHeader, "RowHeader", ScriptForge.V_BOOLEAN) Then GoTo Finally
|
|
End If
|
|
|
|
vCharts = Charts(SheetName)
|
|
If ScriptForge.SF_Array.Contains(vCharts, ChartName, CaseSensitive := True) Then GoTo CatchDuplicate
|
|
|
|
Try:
|
|
' The rectangular shape receives arbitrary values. User can Resize() it later
|
|
With oRectangle
|
|
.X = 0 : .Y = 0
|
|
.Width = 8000 : .Height = 6000
|
|
End With
|
|
' Initialize sheet and range
|
|
Set oSheet = _Component.getSheets.getByName(SheetName)
|
|
Set oRange = _ParseAddress(Range)
|
|
' Create the chart and get ihe corresponding chart instance
|
|
oSheet.getCharts.addNewByName(ChartName, oRectangle, Array(oRange.XCellRange.RangeAddress), ColumnHeader, RowHeader)
|
|
Set oChart = Charts(SheetName, ChartName)
|
|
oChart._Shape.Name = ChartName ' Both used-defined and internal names match ChartName
|
|
oChart._Diagram.Wall.FillColor = RGB(255, 255, 255) ' Align on background color set by the user interface by default
|
|
|
|
Finally:
|
|
Set CreateChart = oChart
|
|
ScriptForge.SF_Utils._ExitFunction(cstThisSub)
|
|
Exit Function
|
|
Catch:
|
|
GoTo Finally
|
|
CatchDuplicate:
|
|
ScriptForge.SF_Exception.RaiseFatal(DUPLICATECHARTERROR, "ChartName", ChartName, "SheetName", SheetName, "Document", [_Super]._FileIdent())
|
|
GoTo Finally
|
|
End Function ' SFDocuments.SF_Calc.CreateChart
|
|
|
|
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 as 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 -----------------------------------------------------------------------------
|
|
Public Function Forms(Optional ByVal SheetName As Variant _
|
|
, Optional ByVal Form As Variant _
|
|
) As Variant
|
|
''' Return either
|
|
''' - the list of the Forms contained in the given sheet
|
|
''' - a SFDocuments.Form object based on its name or its index
|
|
''' Args:
|
|
''' SheetName: the name of the sheet containing the requested form or forms
|
|
''' Form: a form stored in the document given by its name or its index
|
|
''' When absent, the list of available forms is returned
|
|
''' To get the first (unique ?) form stored in the form document, set Form = 0
|
|
''' Exceptions:
|
|
''' CALCFORMNOTFOUNDERROR Form not found
|
|
''' Returns:
|
|
''' A zero-based array of strings if Form is absent
|
|
''' An instance of the SF_Form class if Form exists
|
|
''' Example:
|
|
''' Dim myForm As Object, myList As Variant
|
|
''' myList = oDoc.Forms("ThisSheet")
|
|
''' Set myForm = oDoc.Forms("ThisSheet", 0)
|
|
|
|
Dim oForm As Object ' The new Form class instance
|
|
Dim oMainForm As Object ' com.sun.star.comp.sdb.Content
|
|
Dim oXForm As Object ' com.sun.star.form.XForm or com.sun.star.comp.forms.ODatabaseForm
|
|
Dim vFormNames As Variant ' Array of form names
|
|
Dim oForms As Object ' Forms collection
|
|
Const cstDrawPage = -1 ' There is no DrawPages collection in Calc sheets
|
|
|
|
Const cstThisSub = "SFDocuments.Calc.Forms"
|
|
Const cstSubArgs = "SheetName, [Form=""""]"
|
|
|
|
If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
|
|
|
|
Check:
|
|
If IsMissing(Form) Or IsEmpty(Form) Then Form = ""
|
|
If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
|
|
If Not _IsStillAlive() Then GoTo Finally
|
|
If Not _ValidateSheet(SheetName, "SheetName", , True) Then GoTo Finally
|
|
If Not ScriptForge.SF_Utils._Validate(Form, "Form", Array(V_STRING, ScriptForge.V_NUMERIC)) Then GoTo Finally
|
|
End If
|
|
|
|
Try:
|
|
' Start from the Calc sheet and go down to forms
|
|
Set oForms = _Component.getSheets.getByName(SheetName).DrawPage.Forms
|
|
vFormNames = oForms.getElementNames()
|
|
|
|
If Len(Form) = 0 Then ' Return the list of valid form names
|
|
Forms = vFormNames
|
|
Else
|
|
If VarType(Form) = V_STRING Then ' Find the form by name
|
|
If Not ScriptForge.SF_Utils._Validate(Form, "Form", V_STRING, vFormNames) Then GoTo Finally
|
|
Set oXForm = oForms.getByName(Form)
|
|
Else ' Find the form by index
|
|
If Form < 0 Or Form >= oForms.Count Then GoTo CatchNotFound
|
|
Set oXForm = oForms.getByIndex(Form)
|
|
End If
|
|
' Create the new Form class instance
|
|
Set oForm = SF_Register._NewForm(oXForm)
|
|
With oForm
|
|
Set .[_Parent] = [Me]
|
|
._SheetName = SheetName
|
|
._FormType = ISCALCFORM
|
|
Set ._Component = _Component
|
|
._Initialize()
|
|
End With
|
|
Set Forms = oForm
|
|
End If
|
|
|
|
Finally:
|
|
ScriptForge.SF_Utils._ExitFunction(cstThisSub)
|
|
Exit Function
|
|
Catch:
|
|
GoTo Finally
|
|
CatchNotFound:
|
|
ScriptForge.SF_Exception.RaiseFatal(CALCFORMNOTFOUNDERROR, Form, _FileIdent())
|
|
End Function ' SFDocuments.SF_Calc.Forms
|
|
|
|
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 _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)
|
|
ElseIf Len(ObjectName) = 0 Then
|
|
GetProperty = _PropertyGet(PropertyName)
|
|
Else
|
|
GetProperty = _PropertyGet(PropertyName, ObjectName)
|
|
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 _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
|
|
''' Beforehand 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 _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
|
|
''' Beforehand 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 a range of cells, 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 _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 _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 Calc service as an array
|
|
|
|
Methods = Array( _
|
|
"Activate" _
|
|
, "ClearAll" _
|
|
, "ClearFormats" _
|
|
, "ClearValues" _
|
|
, "CloseDocument" _
|
|
, "CopySheet" _
|
|
, "CopySheetFromFile" _
|
|
, "CopyToCell" _
|
|
, "CopyToRange" _
|
|
, "DAvg" _
|
|
, "DCount" _
|
|
, "DMax" _
|
|
, "DMin" _
|
|
, "DSum" _
|
|
, "ExportAsPDF" _
|
|
, "GetColumnName" _
|
|
, "GetFormula" _
|
|
, "GetValue" _
|
|
, "ImportFromCSVFile" _
|
|
, "ImportFromDatabase" _
|
|
, "InsertSheet" _
|
|
, "MoveRange" _
|
|
, "MoveSheet" _
|
|
, "Offset" _
|
|
, "PrintOut" _
|
|
, "RemoveSheet" _
|
|
, "RenameSheet" _
|
|
, "RunCommand" _
|
|
, "Save" _
|
|
, "SaveAs" _
|
|
, "SaveCopyAs" _
|
|
, "SetArray" _
|
|
, "SetCellStyle" _
|
|
, "SetFormula" _
|
|
, "SetPrinter" _
|
|
, "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
|
|
''' If given as a range of cells, 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.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 _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 _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 _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 PrintOut(Optional ByVal SheetName As Variant _
|
|
, Optional ByVal Pages As Variant _
|
|
, Optional ByVal Copies As Variant _
|
|
) As Boolean
|
|
''' Send the content of the given sheet to the printer.
|
|
''' The printer might be defined previously by default, by the user or by the SetPrinter() method
|
|
''' Args:
|
|
''' SheetName: the sheet to print. Default = the active sheet
|
|
''' Pages: the pages to print as a string, like in the user interface. Example: "1-4;10;15-18". Default = all pages
|
|
''' Copies: the number of copies
|
|
''' Returns:
|
|
''' True when successful
|
|
''' Examples:
|
|
''' oDoc.PrintOut("SheetX", "1-4;10;15-18", Copies := 2)
|
|
|
|
Dim bPrint As Boolean ' Return value
|
|
Dim oSheet As Object ' SheetName as a reference
|
|
|
|
Const cstThisSub = "SFDocuments.Calc.PrintOut"
|
|
Const cstSubArgs = "[SheetName=""~""], [Pages=""""], [Copies=1]"
|
|
|
|
If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
|
|
bPrint = False
|
|
|
|
Check:
|
|
If IsMissing(SheetName) Or IsEmpty(SheetName) Then SheetName = ""
|
|
If IsMissing(Pages) Or IsEmpty(Pages) Then Pages = ""
|
|
If IsMissing(Copies) Or IsEmpty(Copies) Then Copies = 1
|
|
|
|
If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
|
|
If Not _IsStillAlive() Then GoTo Finally
|
|
If Not _ValidateSheet(SheetName, "SheetName", , True, True) Then GoTo Finally
|
|
If Not ScriptForge.SF_Utils._Validate(Pages, "Pages", V_STRING) Then GoTo Finally
|
|
If Not ScriptForge.SF_Utils._Validate(Copies, "Copies", ScriptForge.V_NUMERIC) Then GoTo Finally
|
|
End If
|
|
|
|
Try:
|
|
If SheetName = "~" Then SheetName = ""
|
|
' Make given sheet active
|
|
If Len(SheetName) > 0 Then
|
|
With _Component
|
|
Set oSheet = .getSheets.getByName(SheetName)
|
|
Set .CurrentController.ActiveSheet = oSheet
|
|
End With
|
|
End If
|
|
|
|
bPrint = [_Super].PrintOut(Pages, Copies, _Component)
|
|
|
|
Finally:
|
|
PrintOut = bPrint
|
|
ScriptForge.SF_Utils._ExitFunction(cstThisSub)
|
|
Exit Function
|
|
Catch:
|
|
GoTo Finally
|
|
End Function ' SFDocuments.SF_Calc.PrintOut
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Public Function Properties() As Variant
|
|
''' Return the list or properties of the Calc 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 _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 _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 _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 _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 _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 _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. Default = False
|
|
''' 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""], [DestinationCell=""""], [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 _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
|
|
vSortDescriptor = ScriptForge.SF_Utils._SetPropertyValue(vSortDescriptor, "IsSortColumns", SortColumns)
|
|
vSortDescriptor = ScriptForge.SF_Utils._SetPropertyValue(vSortDescriptor, "ContainsHeader", ContainsHeader)
|
|
vSortDescriptor = ScriptForge.SF_Utils._SetPropertyValue(vSortDescriptor, "BindFormatsToContent", True)
|
|
If Len(DestinationCell) = 0 Then
|
|
vSortDescriptor = 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
|
|
vSortDescriptor = ScriptForge.SF_Utils._SetPropertyValue(vSortDescriptor, "CopyOutputData", True)
|
|
vSortDescriptor = ScriptForge.SF_Utils._SetPropertyValue(vSortDescriptor, "OutputPosition", oDestCell)
|
|
End If
|
|
vSortDescriptor = 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
|
|
vSortDescriptor = 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 Function ExportAsPDF(Optional ByVal FileName As Variant _
|
|
, Optional ByVal Overwrite As Variant _
|
|
, Optional ByVal Pages As Variant _
|
|
, Optional ByVal Password As Variant _
|
|
, Optional ByVal Watermark As Variant _
|
|
) As Boolean
|
|
ExportAsPDF = [_Super].ExportAsPDF(FileName, Overwrite, Pages, Password, Watermark)
|
|
End Function ' SFDocuments.SF_Calc.ExportAsPDF
|
|
|
|
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 -----------------------------------------------------------------------------
|
|
Public Function SetPrinter(Optional ByVal Printer As Variant _
|
|
, Optional ByVal Orientation As Variant _
|
|
, Optional ByVal PaperFormat As Variant _
|
|
) As Boolean
|
|
SetPrinter = [_Super].SetPrinter(Printer, Orientation, PaperFormat)
|
|
End Function ' SFDocuments.SF_Calc.SetPrinter
|
|
|
|
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.getDataArray 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
|
|
''' Input may be a 1D array of arrays, typically when call issued by a Python script
|
|
''' 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 (1) of input array
|
|
Dim lMax1 As Long ' Upper bound (1)
|
|
Dim lMin2 As Long ' Lower bound (2)
|
|
Dim lMax2 As Long ' Upper bound (2)
|
|
Dim lRows As Long ' Upper bound of vDataArray
|
|
Dim lCols As Long ' Upper bound of vVector
|
|
Dim bHorizontal As Boolean ' Horizontal vector
|
|
Dim bDataArray As Boolean ' Input array is already an array of arrays
|
|
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 )
|
|
bDataArray = IsArray(pvArray(0))
|
|
If Not bDataArray Then
|
|
If Not bHorizontal Then
|
|
lMin1 = LBound(pvArray) : lMax1 = UBound(pvArray)
|
|
Else
|
|
lMin2 = LBound(pvArray) : lMax2 = UBound(pvArray)
|
|
End If
|
|
Else
|
|
iDims = 2
|
|
lMin1 = LBound(pvArray) : lMax1 = UBound(pvArray)
|
|
lMin2 = LBound(pvArray(0)) : lMax2 = UBound(pvArray(0))
|
|
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
|
|
If bDataArray Then
|
|
vItem = _ConvertToCellValue(pvArray(i + lMin1)(j + lMin2))
|
|
Else
|
|
vItem = _ConvertToCellValue(pvArray(i + lMin1, j + lMin2))
|
|
End If
|
|
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 _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 -----------------------------------------------------------------------------
|
|
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 = [_Super]._FileIdent()
|
|
|
|
End Function ' SFDocuments.SF_Calc._FileIdent
|
|
|
|
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 _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
|
|
|
|
If IsMissing(pbForUpdate) Then pbForUpdate = False
|
|
If IsMissing(pbError) Then pbError = True
|
|
|
|
Try:
|
|
bAlive = [_Super]._IsStillAlive(pbForUpdate, pbError)
|
|
|
|
Finally:
|
|
_IsStillAlive = bAlive
|
|
Exit Function
|
|
End Function ' SFDocuments.SF_Calc._IsStillAlive
|
|
|
|
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
|
|
.ServiceName = SERVICEREFERENCE
|
|
.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 ' Address 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
|
|
.ServiceName = SERVICEREFERENCE
|
|
.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.Calc.get" & psProperty
|
|
ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs)
|
|
If Not _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
|
|
''' pvArgName: the name of the variable to be used in the error message
|
|
''' 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> |