4710 lines
No EOL
220 KiB
XML
4710 lines
No EOL
220 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
|
|
''' - copying and importing massive amounts of data
|
|
'''
|
|
''' 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
|
|
'''
|
|
''' Several methods may receive a "FilterFormula" as argument.
|
|
''' A FilterFormula may be associated with a FilterScope: "row", "column" or "cell".
|
|
''' These arguments determine on which rows/columns/cells of a range the method should be applied
|
|
''' Examples:
|
|
''' oDoc.ClearAll("A1:J10", FilterFormula := "=(A1<=0)", FilterScope := "CELL") ' Clear all negative values
|
|
''' oDoc.ClearAll("SheetX.A1:J10", "=SUM(SheetX.A1:A10)>100", "COLUMN") ' Clear all columns whose sum is greater than 500
|
|
'''
|
|
''' FilterFormula: a Calc formula that returns TRUE or FALSE
|
|
''' the formula is expressed in terms of
|
|
''' - the top-left cell of the range when FilterScope = "CELL"
|
|
''' - the topmost row of the range when FilterScope = "ROW"
|
|
''' - the leftmost column of the range when FilterScope = "COLUMN"
|
|
''' relative and absolute references will be interpreted correctly
|
|
''' FilterScope: the way the formula is applied, once by row, by column, or by individual cell
|
|
'''
|
|
''' 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"
|
|
Private Const RANGEEXPORTERROR = "RANGEEXPORTERROR"
|
|
|
|
REM ============================================================= PRIVATE MEMBERS
|
|
|
|
Private [Me] 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
|
|
|
|
Private _LastParsedAddress As Object ' _Address type - parsed ranges are cached
|
|
|
|
REM ============================================================ MODULE CONSTANTS
|
|
|
|
Private Const cstSHEET = 1
|
|
Private Const cstRANGE = 2
|
|
|
|
Private Const MAXCOLS = 2^14 ' 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
|
|
|
|
Private Const cstSPECIALCHARS = " `~!@#$%^&()-_=+{}|;,<.>"""
|
|
' Presence of a special character forces surrounding the sheet name with single quotes in absolute addresses
|
|
|
|
|
|
REM ====================================================== CONSTRUCTOR/DESTRUCTOR
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Private Sub Class_Initialize()
|
|
Set [Me] = Nothing
|
|
Set [_Super] = Nothing
|
|
ObjectType = "CALC"
|
|
ServiceName = "SFDocuments.Calc"
|
|
Set _Component = Nothing
|
|
Set _LastParsedAddress = 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 FirstCell(Optional ByVal RangeName As Variant) As String
|
|
''' Returns the First used cell in a given range or sheet
|
|
''' When the argument is a sheet it will always return the "sheet.$A$1" cell
|
|
FirstCell = _PropertyGet("FirstCell", RangeName)
|
|
End Property ' SFDocuments.SF_Calc.FirstCell
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Property Get FirstColumn(Optional ByVal RangeName As Variant) As Long
|
|
''' Returns the leftmost column in a given sheet or range
|
|
''' When the argument is a sheet it will always return 1
|
|
FirstColumn = _PropertyGet("FirstColumn", RangeName)
|
|
End Property ' SFDocuments.SF_Calc.FirstColumn
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Property Get FirstRow(Optional ByVal RangeName As Variant) As Long
|
|
''' Returns the First used column in a given range
|
|
''' When the argument is a sheet it will always return 1
|
|
FirstRow = _PropertyGet("FirstRow", RangeName)
|
|
End Property ' SFDocuments.SF_Calc.FirstRow
|
|
|
|
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 RangeName As Variant) As String
|
|
''' Returns the last used cell in a given sheet or range
|
|
LastCell = _PropertyGet("LastCell", RangeName)
|
|
End Property ' SFDocuments.SF_Calc.LastCell
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Property Get LastColumn(Optional ByVal RangeName As Variant) As Long
|
|
''' Returns the last used column in a given sheet
|
|
LastColumn = _PropertyGet("LastColumn", RangeName)
|
|
End Property ' SFDocuments.SF_Calc.LastColumn
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Property Get LastRow(Optional ByVal RangeName As Variant) As Long
|
|
''' Returns the last used column in a given sheet
|
|
LastRow = _PropertyGet("LastRow", RangeName)
|
|
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 Region(Optional ByVal RangeName As Variant) As String
|
|
''' Returns the smallest area as a range string that contains the given range
|
|
''' and which is completely surrounded with empty cells
|
|
Region = _PropertyGet("Region", RangeName)
|
|
End Property ' SFDocuments.SF_Calc.Region
|
|
|
|
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 SheetName(Optional ByVal RangeName As Variant) As String
|
|
''' Returns the sheet name part of a range
|
|
SheetName = _PropertyGet("SheetName", RangeName)
|
|
End Property ' SFDocuments.SF_Calc.SheetName
|
|
|
|
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 XSheetCellCursor(Optional ByVal RangeName As Variant) As Variant
|
|
''' Returns a UNO object of type com.sun.star.sheet.XSheetCellCursor
|
|
'' After having moved the cursor (gotoNext(), ...) the resulting range can be got
|
|
''' back as a string with the cursor.AbsoluteName UNO property.
|
|
XSheetCellCursor = _PropertyGet("XSheetCellCursor", RangeName)
|
|
End Property ' SFDocuments.SF_Calc.XSheetCellCursor
|
|
|
|
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 A1Style(Optional ByVal Row1 As Variant _
|
|
, Optional ByVal Column1 As Variant _
|
|
, Optional ByVal Row2 As Variant _
|
|
, Optional ByVal Column2 As Variant _
|
|
, Optional ByVal SheetName As Variant _
|
|
) As String
|
|
''' Returns a range expressed in A1-style as defined by its coordinates
|
|
''' If only one pair of coordinates is given, the range will embrace only a single cell
|
|
''' Args:
|
|
''' Row1 : the row number of the first coordinate
|
|
''' Column1 : the column number of the first coordinates
|
|
''' Row2 : the row number of the second coordinate
|
|
''' Column2 : the column number of the second coordinates
|
|
''' SheetName: Default = the current sheet. If present, the sheet must exist.
|
|
''' Returns:
|
|
''' A range as a string
|
|
''' Exceptions:
|
|
''' Examples:
|
|
''' range = oDoc.A1Style(5, 2, 10, 4, "SheetX") ' "'$SheetX'.$E$2:$J$4"
|
|
|
|
Dim sA1Style As String ' Return value
|
|
Dim vSheetName As Variant ' Alias of SheetName - necessary see [Bug 145279]
|
|
Dim lTemp As Long ' To switch 2 values
|
|
Dim i As Long
|
|
|
|
Const cstThisSub = "SFDocuments.Calc.A1Style"
|
|
Const cstSubArgs = "Row1, Column1, [Row2], [Column2], [SheetName]="""""
|
|
|
|
If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
|
|
sA1Style = ""
|
|
|
|
Check:
|
|
If IsMissing(Row2) Or IsEmpty(Row2) Then Row2 = 0
|
|
If IsMissing(Column2) Or IsEmpty(Column2) Then Column2 = 0
|
|
If IsMissing(SheetName) Or IsEmpty(SheetName) Then SheetName = "~"
|
|
vSheetName = SheetName
|
|
|
|
If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
|
|
If Not _IsStillAlive() Then GoTo Finally
|
|
If Not ScriptForge.SF_Utils._Validate(Row1, "Row1", ScriptForge.V_NUMERIC) Then GoTo Finally
|
|
If Not ScriptForge.SF_Utils._Validate(Column1, "Column1", ScriptForge.V_NUMERIC) Then GoTo Finally
|
|
If Not ScriptForge.SF_Utils._Validate(Row2, "Row2", ScriptForge.V_NUMERIC) Then GoTo Finally
|
|
If Not ScriptForge.SF_Utils._Validate(Column2, "Column2", ScriptForge.V_NUMERIC) Then GoTo Finally
|
|
If Not _ValidateSheet(vSheetName, "SheetName", , True, True, , , True) Then GoTo Finally
|
|
End If
|
|
|
|
If Row1 > MAXROWS Then Row1 = MAXROWS
|
|
If Row2 > MAXROWS Then Row2 = MAXROWS
|
|
If Column1 > MAXCOLS Then Column1 = MAXCOLS
|
|
If Column2 > MAXCOLS Then Column2 = MAXCOLS
|
|
|
|
If Row2 > 0 And Row2 < Row1 Then
|
|
lTemp = Row2 : Row2 = Row1 : Row1 = lTemp
|
|
End If
|
|
If Column2 > 0 And Column2 < Column1 Then
|
|
lTemp = Column2 : Column2 = Column1 : Column1 = lTemp
|
|
End If
|
|
|
|
Try:
|
|
' Surround the sheet name with single quotes when required by the presence of special characters
|
|
vSheetName = _QuoteSheetName(vSheetName)
|
|
' Define the new range string
|
|
sA1Style = "$" & vSheetName & "." _
|
|
& "$" & _GetColumnName(Column1) & "$" & CLng(Row1) _
|
|
& Iif(Row2 > 0 And Column2 > 0, ":$" & _GetColumnName(Column2) & "$" & CLng(Row2), "")
|
|
|
|
Finally:
|
|
A1Style = sA1Style
|
|
ScriptForge.SF_Utils._ExitFunction(cstThisSub)
|
|
Exit Function
|
|
Catch:
|
|
GoTo Finally
|
|
End Function ' SFDocuments.SF_Calc.A1Style
|
|
|
|
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, True) 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 _
|
|
, Optional FilterFormula As Variant _
|
|
, Optional FilterScope As Variant _
|
|
)
|
|
''' Clear entirely the given range
|
|
''' Args:
|
|
''' Range : the cell or the range as a string that should be cleared
|
|
''' FilterFormula: a Calc formula to select among the given Range
|
|
''' When left empty, all the cells of the range are cleared
|
|
''' FilterScope: "CELL" (default value), "ROW" or "COLUMN"
|
|
''' When FilterFormula is present, FilterScope is mandatory
|
|
''' Examples:
|
|
''' oDoc.ClearAll("SheetX") ' Clears the used area of the sheet
|
|
''' oDoc.ClearAll("A1:J20", "=($A1=0)", "ROW") ' Clears all rows when 1st cell is zero
|
|
|
|
_ClearRange("All", Range, FilterFormula, FilterScope)
|
|
|
|
End Sub ' SFDocuments.SF_Calc.ClearAll
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Public Sub ClearFormats(Optional ByVal Range As Variant _
|
|
, Optional FilterFormula As Variant _
|
|
, Optional FilterScope As Variant _
|
|
)
|
|
''' Clear all the formatting elements of the given range
|
|
''' Args:
|
|
''' Range : the cell or the range as a string that should be cleared
|
|
''' FilterFormula: a Calc formula to select among the given Range
|
|
''' When left empty, all the cells of the range are cleared
|
|
''' FilterScope: "CELL" (default value), "ROW" or "COLUMN"
|
|
''' When FilterFormula is present, FilterScope is mandatory
|
|
''' Examples:
|
|
''' oDoc.ClearFormats("SheetX.*") ' Clears the used area of the sheet
|
|
''' oDoc.ClearFormats("A1:J20", "=(MOD(A1;0)=0)", "CELL") ' Clears all even cells
|
|
|
|
_ClearRange("Formats", Range, FilterFormula, FilterScope)
|
|
|
|
End Sub ' SFDocuments.SF_Calc.ClearFormats
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Public Sub ClearValues(Optional ByVal Range As Variant _
|
|
, Optional FilterFormula As Variant _
|
|
, Optional FilterScope As Variant _
|
|
)
|
|
''' Clear values and formulas in the given range
|
|
''' Args:
|
|
''' Range : the cell or the range as a string that should be cleared
|
|
''' FilterFormula: a Calc formula to select among the given Range
|
|
''' When left empty, all the cells of the range are cleared
|
|
''' FilterScope: "CELL" (default value), "ROW" or "COLUMN"
|
|
''' When FilterFormula is present, FilterScope is mandatory
|
|
''' Examples:
|
|
''' oDoc.ClearValues("SheetX.*") ' Clears the used area of the sheet
|
|
''' oDoc.ClearValues("A2:A20", "=(A2=A1)", "CELL") ' Clears all duplicate cells
|
|
|
|
_ClearRange("Values", Range, FilterFormula, FilterScope)
|
|
|
|
End Sub ' SFDocuments.SF_Calc.ClearValues
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Public Function CompactLeft(Optional ByVal Range As Variant _
|
|
, Optional ByVal WholeColumn As Variant _
|
|
, Optional ByVal FilterFormula As Variant _
|
|
) As String
|
|
''' Delete the columns of a specified range matching a filter expressed as a formula
|
|
''' applied on each column.
|
|
''' The deleted cells can span whole columns or be limited to the height of the range
|
|
''' The execution of the method has no effect on the current selection
|
|
''' Args:
|
|
''' Range: the range in which cells have to be erased, as a string
|
|
''' WholeColumn: when True (default = False), erase whole columns
|
|
''' FilterFormula: the formula to be applied on each column.
|
|
''' The column is erased when the formula results in True,
|
|
''' The formula shall probably involve one or more cells of the first column of the range.
|
|
''' By default, a column is erased when all the cells of the column are empty,
|
|
''' i.e. suppose the range is "A1:J200" (height = 200) the default value becomes
|
|
''' "=(COUNTBLANK(A1:A200)=200)"
|
|
''' Returns:
|
|
''' A string representing the location of the initial range after compaction,
|
|
''' or the zero-length string if the whole range has been deleted
|
|
''' Examples:
|
|
''' newrange = oDoc.CompactLeft("SheetX.G1:L10") ' All empty columns of the range are suppressed
|
|
''' newrange = oDoc.CompactLeft("SheetX.G1:L10", WholeColumn := True, FilterFormula := "=(G$7=""X"")")
|
|
''' ' The columns having a "X" in row 7 are completely suppressed
|
|
|
|
Dim sCompact As String ' Return value
|
|
Dim oCompact As Object ' Return value as an _Address type
|
|
Dim lCountDeleted As Long ' Count the deleted columns
|
|
Dim vCompactRanges As Variant ' Array of ranges to be compacted based on the formula
|
|
Dim oSourceAddress As Object ' Alias of Range as _Address
|
|
Dim oPartialRange As Object ' Contiguous columns to be deleted
|
|
Dim sShiftRange As String ' Contiguous columns to be shifted
|
|
Dim i As Long
|
|
|
|
Const cstThisSub = "SFDocuments.Calc.CompactLeft"
|
|
Const cstSubArgs = "Range, [WholeColumn=False], [FilterFormula=""""]"
|
|
|
|
If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
|
|
sCompact = ""
|
|
|
|
Check:
|
|
If IsMissing(WholeColumn) Or IsEmpty(WholeColumn) Then WholeColumn = False
|
|
If IsMissing(FilterFormula) Or IsEmpty(FilterFormula) Then FilterFormula = ""
|
|
If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
|
|
If Not _IsStillAlive(True) Then GoTo Finally
|
|
If Not ScriptForge.SF_Utils._Validate(Range, "Range", V_STRING) Then GoTo Finally
|
|
If Not ScriptForge.SF_Utils._Validate(WholeColumn, "WholeColumn", ScriptForge.V_BOOLEAN) Then GoTo Finally
|
|
If Not ScriptForge.SF_Utils._Validate(FilterFormula, "FilterFormula", V_STRING) Then GoTo Finally
|
|
End If
|
|
|
|
Try:
|
|
Set oSourceAddress = _ParseAddress(Range)
|
|
lCountDeleted = 0
|
|
|
|
With oSourceAddress
|
|
|
|
' Set the default formula => all cells are blank
|
|
If FilterFormula = "" Then FilterFormula = Printf("=(COUNTBLANK(%C1%R1:%C1%R2)-" & .Height & "=0)", Range)
|
|
|
|
' Identify the ranges to compact based on the given formula
|
|
vCompactRanges = _ComputeFilter(oSourceAddress, FilterFormula, "COLUMN")
|
|
|
|
' Iterate through the ranges from bottom to top and shift them up
|
|
For i = UBound(vCompactRanges) To 0 Step -1
|
|
Set oPartialRange = vCompactRanges(i)
|
|
ShiftLeft(oPartialRange.RangeName, WholeColumn)
|
|
lCountDeleted = lCountDeleted + oPartialRange.Width
|
|
Next i
|
|
|
|
' Compute the final range position
|
|
If lCountDeleted > 0 Then
|
|
sCompact = Offset(Range, 0, 0, 0, .Width - lCountDeleted)
|
|
' Push to the right the cells that migrated leftwards irrelevantly
|
|
If Not WholeColumn Then
|
|
sShiftRange = Offset(sCompact, 0, .Width - lCountDeleted, , lCountDeleted)
|
|
ShiftRight(sShiftRange, WholeColumn := False)
|
|
End If
|
|
' Conventionally, if all columns are deleted, the returned range is the zero-length string
|
|
If .Width = lCountDeleted Then sCompact = ""
|
|
Else ' Initial range is left unchanged
|
|
sCompact = .RangeName
|
|
End If
|
|
|
|
End With
|
|
|
|
Finally:
|
|
CompactLeft = sCompact
|
|
ScriptForge.SF_Utils._ExitFunction(cstThisSub)
|
|
Exit Function
|
|
Catch:
|
|
' When error, return the original range
|
|
If Not IsNull(oSourceAddress) Then sCompact = oSourceAddress.RangeName
|
|
GoTo Finally
|
|
End Function ' SFDocuments.SF_Calc.CompactLeft
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Public Function CompactUp(Optional ByVal Range As Variant _
|
|
, Optional ByVal WholeRow As Variant _
|
|
, Optional ByVal FilterFormula As Variant _
|
|
) As String
|
|
''' Delete the rows of a specified range matching a filter expressed as a formula
|
|
''' applied on each row.
|
|
''' The deleted cells can span whole rows or be limited to the width of the range
|
|
''' The execution of the method has no effect on the current selection
|
|
''' Args:
|
|
''' Range: the range in which cells have to be erased, as a string
|
|
''' WholeRow: when True (default = False), erase whole rows
|
|
''' FilterFormula: the formula to be applied on each row.
|
|
''' The row is erased when the formula results in True,
|
|
''' The formula shall probably involve one or more cells of the first row of the range.
|
|
''' By default, a row is erased when all the cells of the row are empty,
|
|
''' i.e. suppose the range is "A1:J200" (width = 10) the default value becomes
|
|
''' "=(COUNTBLANK(A1:J1)=10)"
|
|
''' Returns:
|
|
''' A string representing the location of the initial range after compaction,
|
|
''' or the zero-length string if the whole range has been deleted
|
|
''' Examples:
|
|
''' newrange = oDoc.CompactUp("SheetX.G1:L10") ' All empty rows of the range are suppressed
|
|
''' newrange = oDoc.CompactUp("SheetX.G1:L10", WholeRow := True, FilterFormula := "=(G1=""X"")")
|
|
''' ' The rows having a "X" in column G are completely suppressed
|
|
|
|
Dim sCompact As String ' Return value
|
|
Dim lCountDeleted As Long ' Count the deleted rows
|
|
Dim vCompactRanges As Variant ' Array of ranges to be compacted based on the formula
|
|
Dim oSourceAddress As Object ' Alias of Range as _Address
|
|
Dim oPartialRange As Object ' Contiguous rows to be deleted
|
|
Dim sShiftRange As String ' Contiguous rows to be shifted
|
|
Dim i As Long
|
|
|
|
Const cstThisSub = "SFDocuments.Calc.CompactUp"
|
|
Const cstSubArgs = "Range, [WholeRow=False], [FilterFormula=""""]"
|
|
|
|
If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
|
|
sCompact = ""
|
|
|
|
Check:
|
|
If IsMissing(WholeRow) Or IsEmpty(WholeRow) Then WholeRow = False
|
|
If IsMissing(FilterFormula) Or IsEmpty(FilterFormula) Then FilterFormula = ""
|
|
If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
|
|
If Not _IsStillAlive(True) Then GoTo Finally
|
|
If Not ScriptForge.SF_Utils._Validate(Range, "Range", V_STRING) Then GoTo Finally
|
|
If Not ScriptForge.SF_Utils._Validate(WholeRow, "WholeRow", ScriptForge.V_BOOLEAN) Then GoTo Finally
|
|
If Not ScriptForge.SF_Utils._Validate(FilterFormula, "FilterFormula", V_STRING) Then GoTo Finally
|
|
End If
|
|
|
|
Try:
|
|
Set oSourceAddress = _ParseAddress(Range)
|
|
lCountDeleted = 0
|
|
|
|
With oSourceAddress
|
|
|
|
' Set the default formula => all cells are blank
|
|
If FilterFormula = "" Then FilterFormula = Printf("=(COUNTBLANK(%C1%R1:%C2%R1)-" & .Width & "=0)", Range)
|
|
|
|
' Identify the ranges to compact based on the given formula
|
|
vCompactRanges = _ComputeFilter(oSourceAddress, FilterFormula, "ROW")
|
|
|
|
' Iterate through the ranges from bottom to top and shift them up
|
|
For i = UBound(vCompactRanges) To 0 Step -1
|
|
Set oPartialRange = vCompactRanges(i)
|
|
ShiftUp(oPartialRange.RangeName, WholeRow)
|
|
lCountDeleted = lCountDeleted + oPartialRange.Height
|
|
Next i
|
|
|
|
' Compute the final range position
|
|
If lCountDeleted > 0 Then
|
|
sCompact = Offset(Range, 0, 0, .Height - lCountDeleted, 0)
|
|
' Push downwards the cells that migrated upwards irrelevantly
|
|
If Not WholeRow Then
|
|
sShiftRange = Offset(sCompact, .Height - lCountDeleted, 0, lCountDeleted)
|
|
ShiftDown(sShiftRange, WholeRow := False)
|
|
End If
|
|
' Conventionally, if all rows are deleted, the returned range is the zero-length string
|
|
If .Height = lCountDeleted Then sCompact = ""
|
|
Else ' Initial range is left unchanged
|
|
sCompact = .RangeName
|
|
End If
|
|
|
|
End With
|
|
|
|
Finally:
|
|
CompactUp = sCompact
|
|
ScriptForge.SF_Utils._ExitFunction(cstThisSub)
|
|
Exit Function
|
|
Catch:
|
|
' When error, return the original range
|
|
If Not IsNull(oSourceAddress) Then sCompact = oSourceAddress.RangeName
|
|
GoTo Finally
|
|
End Function ' SFDocuments.SF_Calc.CompactUp
|
|
|
|
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.NV", 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 via 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 user-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 CreatePivotTable(Optional ByVal PivotTableName As Variant _
|
|
, Optional ByVal SourceRange As Variant _
|
|
, Optional ByVal TargetCell As Variant _
|
|
, Optional ByRef DataFields As Variant _
|
|
, Optional ByRef RowFields As Variant _
|
|
, Optional ByRef ColumnFields As Variant _
|
|
, Optional ByVal FilterButton As Variant _
|
|
, Optional ByVal RowTotals As Variant _
|
|
, Optional ByVal ColumnTotals As Variant _
|
|
) As String
|
|
''' Create a new pivot table with the properties defined by the arguments.
|
|
''' If a pivot table with the same name exists already in the targeted sheet, it will be erased without warning.
|
|
''' Args:
|
|
''' PivotTableName: The user-defined name of the new pivottable
|
|
''' SourceRange: The range as a string containing the raw data.
|
|
''' The first row of the range is presumed to contain the field names of the new pivot table
|
|
''' TargetCell: the top left cell or the range as a string where to locate the pivot table.
|
|
''' Only the top left cell of the range will be considered.
|
|
''' DataFields: A single string or an array of field name + function to apply, formatted like:
|
|
''' Array("FieldName[;Function]", ...)
|
|
''' The allowed functions are: Sum, Count, Average, Max, Min, Product, CountNums, StDev, StDevP, Var, VarP and Median.
|
|
''' The default function is: When the values are all numerical, Sum is used, otherwise Count
|
|
''' RowFields: A single string or an array of the field names heading the pivot table rows
|
|
''' ColumnFields: A single string or an array of the field names heading the pivot table columns
|
|
''' FilterButton: When True (default), display a "Filter" button above the pivot table
|
|
''' RowTotals: When True (default), display a separate column for row totals
|
|
''' ColumnTotals: When True (default), display a separate row for column totals
|
|
''' Returns:
|
|
''' Return the range where the new pivot table is deployed.
|
|
''' Examples:
|
|
''' Dim vData As Variant, oDoc As Object, sTable As String, sPivot As String
|
|
''' vData = Array(Array("Item", "State", "Team", "2002", "2003", "2004"), _
|
|
''' Array("Books", "Michigan", "Jean", 14788, 30222, 23490), _
|
|
''' Array("Candy", "Michigan", "Jean", 26388, 15641, 32849), _
|
|
''' Array("Pens", "Michigan", "Jean", 16569, 32675, 25396), _
|
|
''' Array("Books", "Michigan", "Volker", 21961, 21242, 29009), _
|
|
''' Array("Candy", "Michigan", "Volker", 26142, 22407, 32841))
|
|
''' Set oDoc = ui.CreateDocument("Calc")
|
|
''' sTable = oDoc.SetArray("A1", vData)
|
|
''' sPivot = oDoc.CreatePivotTable("PT1", sTable, "H1", Array("2002", "2003;count", "2004;average"), "Item", Array("State", "Team"), False)
|
|
|
|
Dim sPivotTable As String ' Return value
|
|
Dim vData As Variant ' Alias of DataFields
|
|
Dim vRows As Variant ' Alias of RowFields
|
|
Dim vColumns As Variant ' Alias of ColumnFields
|
|
Dim oSourceAddress As Object ' Source as an _Address
|
|
Dim oTargetAddress As Object ' Target as an _Address
|
|
Dim vHeaders As Variant ' Array of header fields in the source range
|
|
Dim oPivotTables As Object ' com.sun.star.sheet.XDataPilotTables
|
|
Dim oDescriptor As Object ' com.sun.star.sheet.DataPilotDescriptor
|
|
Dim oFields As Object ' ScDataPilotFieldsObj - Collection of fields
|
|
Dim oField As Object ' ScDataPilotFieldsObj - A single field
|
|
Dim sField As String ' A single field name
|
|
Dim sData As String ' A single data field name + function
|
|
Dim vDataField As Variant ' A single vData element, split on semicolon
|
|
Dim sFunction As String ' Function to apply on a data field (string)
|
|
Dim iFunction As Integer ' Equivalent of sFunction as com.sun.star.sheet.GeneralFunction2 constant
|
|
Dim oOutputRange As Object ' com.sun.star.table.CellRangeAddress
|
|
Dim i As Integer
|
|
|
|
Const cstThisSub = "SFDocuments.Calc.CreatePivotTable"
|
|
Const cstSubArgs = "PivotTableName, SourceRange, TargetCell, DataFields, [RowFields], [ColumnFields]" _
|
|
& ", [FilterButton=True], [RowTotals=True], [ColumnTotals=True]"
|
|
|
|
If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
|
|
sPivotTable = ""
|
|
|
|
Check:
|
|
If IsMissing(RowFields) Or IsEmpty(RowFields) Then RowFields = Array()
|
|
If IsMissing(ColumnFields) Or IsEmpty(ColumnFields) Then ColumnFields = Array()
|
|
If IsMissing(FilterButton) Or IsEmpty(FilterButton) Then FilterButton = True
|
|
If IsMissing(RowTotals) Or IsEmpty(RowTotals) Then RowTotals = True
|
|
If IsMissing(ColumnTotals) Or IsEmpty(ColumnTotals) Then ColumnTotals = True
|
|
If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
|
|
If Not _IsStillAlive(True) Then GoTo Finally
|
|
If Not ScriptForge.SF_Utils._Validate(PivotTableName, "PivotTableName", V_STRING) Then GoTo Finally
|
|
If Not ScriptForge.SF_Utils._Validate(SourceRange, "SourceRange", V_STRING) Then GoTo Finally
|
|
If Not ScriptForge.SF_Utils._Validate(TargetCell, "TargetCell", V_STRING) Then GoTo Finally
|
|
If IsArray(DataFields) Then
|
|
If Not ScriptForge.SF_Utils._ValidateArray(DataFields, "DataFields", 1, V_STRING, True) Then GoTo Finally
|
|
Else
|
|
If Not ScriptForge.SF_Utils._Validate(DataFields, "DataFields", V_STRING) Then GoTo Finally
|
|
End If
|
|
If IsArray(RowFields) Then
|
|
If Not ScriptForge.SF_Utils._ValidateArray(RowFields, "RowFields", 1, V_STRING, True) Then GoTo Finally
|
|
Else
|
|
If Not ScriptForge.SF_Utils._Validate(RowFields, "RowFields", V_STRING) Then GoTo Finally
|
|
End If
|
|
If IsArray(ColumnFields) Then
|
|
If Not ScriptForge.SF_Utils._ValidateArray(ColumnFields, "ColumnFields", 1, V_STRING, True) Then GoTo Finally
|
|
Else
|
|
If Not ScriptForge.SF_Utils._Validate(ColumnFields, "ColumnFields", V_STRING) Then GoTo Finally
|
|
End If
|
|
If Not ScriptForge.SF_Utils._Validate(FilterButton, "FilterButton", ScriptForge.V_BOOLEAN) Then GoTo Finally
|
|
If Not ScriptForge.SF_Utils._Validate(RowTotals, "RowTotals", ScriptForge.V_BOOLEAN) Then GoTo Finally
|
|
If Not ScriptForge.SF_Utils._Validate(ColumnTotals, "ColumnTotals", ScriptForge.V_BOOLEAN) Then GoTo Finally
|
|
End If
|
|
' Next statements must be outside previous If-block to force their execution even in case of internal call
|
|
If IsArray(DataFields) Then vData = DataFields Else vData = Array(DataFields)
|
|
If IsArray(RowFields) Then vRows = RowFields Else vRows = Array(RowFields)
|
|
If IsArray(ColumnFields) Then vColumns = ColumnFields Else vColumns = Array(ColumnFields)
|
|
|
|
Try:
|
|
|
|
Set oSourceAddress = _ParseAddress(SourceRange)
|
|
vHeaders = GetValue(Offset(SourceRange, 0, 0, 1)) ' Content of the first row of the source
|
|
Set oTargetAddress = _Offset(TargetCell, 0, 0, 1, 1) ' Retain the top left cell only
|
|
Set oPivotTables = oTargetAddress.XSpreadsheet.getDataPilotTables()
|
|
|
|
' Initialize new pivot table
|
|
Set oDescriptor = oPivotTables.createDataPilotDescriptor()
|
|
oDescriptor.setSourceRange(oSourceAddress.XCellRange.RangeAddress)
|
|
Set oFields = oDescriptor.getDataPilotFields()
|
|
|
|
' Set row fields
|
|
For i = 0 To UBound(vRows)
|
|
sField = vRows(i)
|
|
If Len(sField) > 0 Then
|
|
If Not ScriptForge.SF_Utils._Validate(sField, "RowFields", V_STRING, vHeaders, True) Then GoTo Finally
|
|
Set oField = oFields.getByName(sField)
|
|
oField.Orientation = com.sun.star.sheet.DataPilotFieldOrientation.ROW
|
|
End If
|
|
Next i
|
|
|
|
' Set column fields
|
|
For i = 0 To UBound(vColumns)
|
|
sField = vColumns(i)
|
|
If Len(sField) > 0 Then
|
|
If Not ScriptForge.SF_Utils._Validate(sField, "ColumnFields", V_STRING, vHeaders, True) Then GoTo Finally
|
|
Set oField = oFields.getByName(sField)
|
|
oField.Orientation = com.sun.star.sheet.DataPilotFieldOrientation.COLUMN
|
|
End If
|
|
Next i
|
|
|
|
' Set data fields
|
|
For i = 0 To UBound(vData)
|
|
sData = vData(i)
|
|
' Minimal parsing
|
|
If Right(sData, 1) = ";" Then sData = Left(sData, Len(sData) - 1)
|
|
vDataField = Split(sData, ";")
|
|
sField = vDataField(0)
|
|
If UBound(vDataField) > 0 Then sFunction = vDataField(1) Else sFunction = ""
|
|
' Define field properties
|
|
If Len(sField) > 0 Then
|
|
If Not ScriptForge.SF_Utils._Validate(sField, "DataFields", V_STRING, vHeaders, True) Then GoTo Finally
|
|
Set oField = oFields.getByName(sField)
|
|
oField.Orientation = com.sun.star.sheet.DataPilotFieldOrientation.DATA
|
|
' Associate the correct function
|
|
With com.sun.star.sheet.GeneralFunction2
|
|
Select Case UCase(sFunction)
|
|
Case "" : iFunction = .AUTO
|
|
Case "SUM" : iFunction = .SUM
|
|
Case "COUNT" : iFunction = .COUNT
|
|
Case "AVERAGE" : iFunction = .AVERAGE
|
|
Case "MAX" : iFunction = .MAX
|
|
Case "MIN" : iFunction = .MIN
|
|
Case "PRODUCT" : iFunction = .PRODUCT
|
|
Case "COUNTNUMS": iFunction = .COUNTNUMS
|
|
Case "STDEV" : iFunction = .STDEV
|
|
Case "STDEVP" : iFunction = .STDEVP
|
|
Case "VAR" : iFunction = .VAR
|
|
Case "VARP" : iFunction = .VARP
|
|
Case "MEDIAN" : iFunction = .MEDIAN
|
|
Case Else
|
|
If Not ScriptForge.SF_Utils._Validate(sFunction, "DataFields/Function", V_STRING _
|
|
, Array("Sum", "Count", "Average", "Max", "Min", "Product", "CountNums" _
|
|
, "StDev", "StDevP", "Var", "VarP", "Median") _
|
|
) Then GoTo Finally
|
|
End Select
|
|
End With
|
|
oField.Function2 = iFunction
|
|
End If
|
|
Next i
|
|
|
|
' Remove any pivot table with same name
|
|
If oPivotTables.hasByName(PivotTableName) Then oPivotTables.removeByName(PivotTableName)
|
|
|
|
' Finalize the new pivot table
|
|
oDescriptor.ShowFilterButton = FilterButton
|
|
oDescriptor.RowGrand = RowTotals
|
|
oDescriptor.ColumnGrand = ColumnTotals
|
|
oPivotTables.insertNewByName(PivotTableName, oTargetAddress.XCellRange.getCellByPosition(0, 0).CellAddress, oDescriptor)
|
|
|
|
' Determine the range of the new pivot table
|
|
Set oOutputRange = oPivotTables.getByName(PivotTableName).OutputRange
|
|
With oOutputRange
|
|
sPivotTable = _Component.getSheets().getCellRangeByPosition(.StartColumn, .StartRow, .EndColumn, .EndRow, .Sheet).AbsoluteName
|
|
End With
|
|
|
|
Finally:
|
|
CreatePivotTable = sPivotTable
|
|
ScriptForge.SF_Utils._ExitFunction(cstThisSub)
|
|
Exit Function
|
|
Catch:
|
|
GoTo Finally
|
|
End Function ' SFDocuments.SF_Calc.CreatePivotTable
|
|
|
|
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 ' SFDocuments.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 ' SFDocuments.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 ' SFDocuments.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 ' SFDocuments.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 ' SFDocuments.SF_Calc.DSum
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Public Function ExportRangeToFile(Optional ByVal Range As Variant _
|
|
, Optional ByVal FileName As Variant _
|
|
, Optional ByVal ImageType As Variant _
|
|
, Optional ByVal Overwrite As Variant _
|
|
) As Boolean
|
|
''' Store the given range as an image to the given file location
|
|
''' Actual selections are not impacted
|
|
''' Inspired by https://stackoverflow.com/questions/30509532/how-to-export-cell-range-to-pdf-file
|
|
''' Args:
|
|
''' Range: sheet name or cell range to be exported, as a string
|
|
''' FileName: Identifies the file where to save. It must follow the SF_FileSystem.FileNaming notation
|
|
''' ImageType: the name of the targeted media type
|
|
''' Allowed values: jpeg, pdf (default) and png
|
|
''' Overwrite: True if the destination file may be overwritten (default = False)
|
|
''' Returns:
|
|
''' False if the document could not be saved
|
|
''' Exceptions:
|
|
''' RANGEEXPORTERROR The destination has its readonly attribute set or overwriting rejected
|
|
''' Examples:
|
|
''' oDoc.ExportRangeToFile('SheetX.B2:J15", "C:\Me\Range2.png", ImageType := "png", Overwrite := True)
|
|
|
|
Dim bSaved As Boolean ' return value
|
|
Dim oSfa As Object ' com.sun.star.ucb.SimpleFileAccess
|
|
Dim sFile As String ' Alias of FileName
|
|
Dim vStoreArguments As Variant ' Array of com.sun.star.beans.PropertyValue
|
|
Dim vFilterData As Variant ' Array of com.sun.star.beans.PropertyValue
|
|
Dim FSO As Object ' SF_FileSystem
|
|
Dim vImageTypes As Variant ' Array of permitted image types
|
|
Dim vFilters As Variant ' Array of corresponding filters in the same order as vImageTypes
|
|
Dim sFilter As String ' The filter to apply
|
|
Dim oSelect As Object ' Currently selected range(s)
|
|
Dim oAddress As Object ' Alias of Range
|
|
|
|
Const cstImageTypes = "jpeg,pdf,png"
|
|
Const cstFilters = "calc_jpg_Export,calc_pdf_Export,calc_png_Export"
|
|
|
|
Const cstThisSub = "SFDocuments.Calc.ExportRangeToFile"
|
|
Const cstSubArgs = "Range, FileName, [ImageType=""pdf""|""jpeg""|""png""], [Overwrite=False]"
|
|
|
|
If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo CatchError
|
|
bSaved = False
|
|
|
|
Check:
|
|
If IsMissing(ImageType) Or IsEmpty(ImageType) Then ImageType = "pdf"
|
|
If IsMissing(Overwrite) Or IsEmpty(Overwrite) Then Overwrite = False
|
|
|
|
vImageTypes = Split(cstImageTypes, ",")
|
|
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._ValidateFile(FileName, "FileName") Then GoTo Finally
|
|
If Not ScriptForge.SF_Utils._Validate(ImageType, "ImageType", V_STRING, vImageTypes) Then GoTo Finally
|
|
If Not ScriptForge.SF_Utils._Validate(Overwrite, "Overwrite", ScriptForge.V_BOOLEAN) Then GoTo Finally
|
|
End If
|
|
|
|
' Check destination file overwriting
|
|
Set FSO = CreateScriptService("FileSystem")
|
|
sFile = FSO._ConvertToUrl(FileName)
|
|
If FSO.FileExists(FileName) Then
|
|
If Overwrite = False Then GoTo CatchError
|
|
Set oSfa = ScriptForge.SF_Utils._GetUNOService("FileAccess")
|
|
If oSfa.isReadonly(sFile) Then GoTo CatchError
|
|
End If
|
|
|
|
Try:
|
|
' Setup arguments
|
|
vFilters = Split(cstFilters, ",")
|
|
sFilter = vFilters(ScriptForge.SF_Array.IndexOf(vImageTypes, ImageType, CaseSensitive := False))
|
|
Set oAddress = _ParseAddress(Range)
|
|
|
|
' The filter arguments differ between
|
|
' 1) pdf : store range in Selection property value
|
|
' 2) png, jpeg : save current selection, select range, restore initial selection
|
|
If LCase(ImageType) = "pdf" Then
|
|
vFilterData = Array(ScriptForge.SF_Utils._MakePropertyValue("Selection", oAddress.XCellRange) )
|
|
vStoreArguments = Array( _
|
|
ScriptForge.SF_Utils._MakePropertyValue("FilterName", sFilter) _
|
|
, ScriptForge.SF_Utils._MakePropertyValue("FilterData", vFilterData) _
|
|
)
|
|
Else ' png, jpeg
|
|
' Save the current selection(s)
|
|
Set oSelect = _Component.CurrentController.getSelection()
|
|
_Component.CurrentController.select(oAddress.XCellRange)
|
|
vStoreArguments = Array( _
|
|
ScriptForge.SF_Utils._MakePropertyValue("FilterName", sFilter) _
|
|
, ScriptForge.SF_Utils._MakePropertyValue("SelectionOnly", True) _
|
|
)
|
|
End If
|
|
|
|
' Apply the filter and export
|
|
_Component.storeToUrl(sFile, vStoreArguments)
|
|
If LCase(ImageType) <> "pdf" Then _RestoreSelections(_Component, oSelect)
|
|
|
|
bSaved = True
|
|
|
|
Finally:
|
|
ExportRangeToFile = bSaved
|
|
ScriptForge.SF_Utils._ExitFunction(cstThisSub)
|
|
Exit Function
|
|
Catch:
|
|
GoTo Finally
|
|
CatchError:
|
|
ScriptForge.SF_Exception.RaiseFatal(RANGEEXPORTERROR, "FileName", FileName, "Overwrite", Overwrite)
|
|
GoTo Finally
|
|
End Function ' SFDocuments.SF_Chart.ExportRangeToFile
|
|
|
|
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, True) 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,..16384) into its letter counterpart (range 'A', 'B',..'XFD').
|
|
''' Args:
|
|
''' ColumnNumber: the column number, must be in the interval 1 ... 16384
|
|
''' Returns:
|
|
''' a string representation of the column name, in range 'A'..'XFD'
|
|
''' 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 = ScriptForge.SF_Array.ConvertFromDataArray(vDataArray)
|
|
|
|
Finally:
|
|
GetFormula = vGet
|
|
ScriptForge.SF_Utils._ExitFunction(cstThisSub)
|
|
Exit Function
|
|
Catch:
|
|
GoTo Finally
|
|
End Function ' SFDocuments.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 = ScriptForge.SF_Array.ConvertFromDataArray(vDataArray)
|
|
|
|
Finally:
|
|
GetValue = vGet
|
|
ScriptForge.SF_Utils._ExitFunction(cstThisSub)
|
|
Exit Function
|
|
Catch:
|
|
GoTo Finally
|
|
End Function ' SFDocuments.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.documentfoundation.org/Documentation/DevGuide/Spreadsheet_Documents#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( _
|
|
"A1Style" _
|
|
, "Charts" _
|
|
, "ClearAll" _
|
|
, "ClearFormats" _
|
|
, "ClearValues" _
|
|
, "CopySheet" _
|
|
, "CopySheetFromFile" _
|
|
, "CopyToCell" _
|
|
, "CopyToRange" _
|
|
, "CreateChart" _
|
|
, "DAvg" _
|
|
, "DCount" _
|
|
, "DMax" _
|
|
, "DMin" _
|
|
, "DSum" _
|
|
, "ExportRangeToFile" _
|
|
, "GetColumnName" _
|
|
, "GetFormula" _
|
|
, "GetValue" _
|
|
, "ImportFromCSVFile" _
|
|
, "ImportFromDatabase" _
|
|
, "InsertSheet" _
|
|
, "MoveRange" _
|
|
, "MoveSheet" _
|
|
, "Offset" _
|
|
, "OpenRangeSelector" _
|
|
, "Printf" _
|
|
, "PrintOut" _
|
|
, "RemoveDuplicates" _
|
|
, "RemoveSheet" _
|
|
, "RenameSheet" _
|
|
, "SetArray" _
|
|
, "SetCellStyle" _
|
|
, "SetFormula" _
|
|
, "SetValue" _
|
|
, "ShiftDown" _
|
|
, "ShiftLeft" _
|
|
, "ShiftRight" _
|
|
, "ShiftUp" _
|
|
, "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 ' SFDocuments.SF_Calc.Offset
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Public Function OpenRangeSelector(Optional ByVal Title As Variant _
|
|
, Optional ByVal Selection As Variant _
|
|
, Optional ByVal SingleCell As Variant _
|
|
, Optional ByVal CloseAfterSelect As Variant _
|
|
) As String
|
|
''' Activates the Calc document, opens a non-modal dialog with a text box,
|
|
''' let the user make a selection in the current or another sheet and
|
|
''' returns the selected area as a string.
|
|
''' This method does not change the current selection.
|
|
''' Args:
|
|
''' Title: the title to display on the top of the dialog
|
|
''' Selection: a default preselection as a String. When absent, the first element of the
|
|
''' current selection is preselected.
|
|
''' SingleCell: When True, only a single cell may be selected. Default = False
|
|
''' CloseAfterSelect: When True (default-, the dialog is closed immediately after
|
|
''' the selection. When False, the user may change his/her mind and must close
|
|
''' the dialog manually.
|
|
''' Returns:
|
|
''' The selected range as a string, or the empty string when the user cancelled the request (close window button)
|
|
''' Exceptions:
|
|
''' Examples:
|
|
''' Dim sSelect As String, vValues As Variant
|
|
''' sSelect = oDoc.OpenRangeSelector("Select a range ...")
|
|
''' If sSelect = "" Then Exit Function
|
|
''' vValues = oDoc.GetValue(sSelect)
|
|
|
|
Dim sSelector As String ' Return value
|
|
Dim vPropertyValues As Variant ' Array of com.sun.star.beans.PropertyValue
|
|
Dim oSelection As Object ' The current selection before opening the selector
|
|
Dim oAddress As Object ' Preselected address as _Address
|
|
|
|
Const cstThisSub = "SFDocuments.Calc.OpenRangeSelector"
|
|
Const cstSubArgs = "[Title=""""], [Selection=""~""], [SingleCell=False], [CloseAfterSelect=True]"
|
|
|
|
If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
|
|
sSelector = ""
|
|
|
|
Check:
|
|
If IsMissing(Title) Or IsEmpty(Title) Then Title = ""
|
|
If IsMissing(Selection) Or IsEmpty(Selection) Then Selection = "~"
|
|
If IsMissing(SingleCell) Or IsEmpty(SingleCell) Then SingleCell = False
|
|
If IsMissing(CloseAfterSelect) Or IsEmpty(CloseAfterSelect) Then CloseAfterSelect = True
|
|
If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
|
|
If Not _IsStillAlive() Then GoTo Finally
|
|
If Not ScriptForge.SF_Utils._Validate(Title, "Title", V_STRING) Then GoTo Finally
|
|
If Not ScriptForge.SF_Utils._Validate(Selection, "Selection", V_STRING) Then GoTo Finally
|
|
If Not ScriptForge.SF_Utils._Validate(SingleCell, "SingleCell", ScriptForge.V_BOOLEAN) Then GoTo Finally
|
|
If Not ScriptForge.SF_Utils._Validate(CloseAfterSelect, "CloseAfterSelect", ScriptForge.V_BOOLEAN) Then GoTo Finally
|
|
End If
|
|
|
|
Try:
|
|
' Save the current selections
|
|
Set oSelection = _Component.CurrentController.getSelection()
|
|
|
|
' Process preselection and select its containing sheet
|
|
Set oAddress = _ParseAddress(Selection)
|
|
Activate(oAddress.SheetName)
|
|
|
|
' Build arguments array and execute the dialog box
|
|
With ScriptForge.SF_Utils
|
|
vPropertyValues = Array( _
|
|
._MakePropertyValue("Title", Title) _
|
|
, ._MakePropertyValue("CloseOnMouseRelease", CloseAfterSelect) _
|
|
, ._MakePropertyValue("InitialValue", oAddress.XCellRange.AbsoluteName) _
|
|
, ._MakePropertyValue("SingleCellMode", SingleCell) _
|
|
)
|
|
End With
|
|
sSelector = SF_DocumentListener.RunRangeSelector(_Component, vPropertyValues)
|
|
|
|
' Restore the saved selections
|
|
_RestoreSelections(_Component, oSelection)
|
|
|
|
Finally:
|
|
OpenRangeSelector = sSelector
|
|
ScriptForge.SF_Utils._ExitFunction(cstThisSub)
|
|
Exit Function
|
|
Catch:
|
|
GoTo Finally
|
|
End Function ' SFDocuments.SF_Calc.OpenRangeSelector
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Public Function Printf(Optional ByVal InputStr As Variant _
|
|
, Optional ByVal Range As Variant _
|
|
, Optional ByVal TokenCharacter As Variant _
|
|
) As String
|
|
''' Returns the input string after substitution of its tokens by
|
|
''' their values in the given range
|
|
''' This method is usually used in combination with SetFormula()
|
|
''' The accepted tokens are:
|
|
''' - %S The sheet name containing the range, including single quotes when necessary
|
|
''' - %R1 The row number of the topleft part of the range
|
|
''' - %C1 The column letter of the topleft part of the range
|
|
''' - %R2 The row number of the bottomright part of the range
|
|
''' - %C2 The column letter of the bottomright part of the range
|
|
''' Args:
|
|
''' InputStr: usually a Calc formula or a part of a formula, but may be any string
|
|
''' Range: the range, as a string from which the values of the tokens are derived
|
|
''' TokenCharacter: the character identifying tokens. Default = "%".
|
|
''' Double the TokenCharacter to not consider it as a token.
|
|
''' Returns:
|
|
''' The input string after substitution of the contained tokens
|
|
''' Exceptions:
|
|
''' Examples:
|
|
''' Assume we have in A1:E10 a matrix of numbers. To obtain the sum by row in F1:F10 ...
|
|
''' Dim range As String, formula As String
|
|
''' range = "$A$1:$E$10")
|
|
''' formula = "=SUM($%C1%R1:$%C2%R1)" ' "=SUM($A1:$E1)", note the relative references
|
|
''' oDoc.SetFormula("$F$1:$F$10", formula)
|
|
''' 'F1 will contain =Sum($A1:$E1)
|
|
''' 'F2 =Sum($A2:$E2)
|
|
''' ' ...
|
|
|
|
Dim sPrintf As String ' Return value
|
|
Dim vSubstitute As Variants ' Array of strings representing the token values
|
|
Dim oAddress As Object ' A range as an _Address object
|
|
Dim sSheetName As String ' The %S token value
|
|
Dim sC1 As String ' The %C1 token value
|
|
Dim sR1 As String ' The %R1 token value
|
|
Dim sC2 As String ' The %C2 token value
|
|
Dim sR2 As String ' The %R2 token value
|
|
Dim i As Long
|
|
Const cstPseudoToken = "@#@"
|
|
|
|
Const cstThisSub = "SFDocuments.Calc.Printf"
|
|
Const cstSubArgs = "InputStr, Range, TokenCharacter=""%"""
|
|
|
|
If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
|
|
sPrintf = ""
|
|
|
|
Check:
|
|
If IsMissing(TokenCharacter) Or IsEmpty(TokenCharacter) Then TokenCharacter = "%"
|
|
If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
|
|
If Not _IsStillAlive() Then GoTo Finally
|
|
If Not ScriptForge.SF_Utils._Validate(InputStr, "InputStr", V_STRING) Then GoTo Finally
|
|
If Not ScriptForge.SF_Utils._Validate(Range, "Range", V_STRING) Then GoTo Finally
|
|
If Not ScriptForge.SF_Utils._Validate(TokenCharacter, "TokenCharacter", V_STRING) Then GoTo Finally
|
|
End If
|
|
|
|
Try:
|
|
' Define the token values
|
|
Set oAddress = _ParseAddress(Range)
|
|
With oAddress.XCellRange
|
|
sC1 = _GetColumnName(.RangeAddress.StartColumn + 1)
|
|
sR1 = CStr(.RangeAddress.StartRow + 1)
|
|
sC2 = _GetColumnName(.RangeAddress.EndColumn + 1)
|
|
sR2 = CStr(.RangeAddress.EndRow + 1)
|
|
sSheetName = _QuoteSheetName(oAddress.XSpreadsheet.Name)
|
|
End With
|
|
|
|
' Substitute tokens by their values
|
|
sPrintf = ScriptForge.SF_String.ReplaceStr(InputStr _
|
|
, Array(TokenCharacter & TokenCharacter _
|
|
, TokenCharacter & "R1" _
|
|
, TokenCharacter & "C1" _
|
|
, TokenCharacter & "R2" _
|
|
, TokenCharacter & "C2" _
|
|
, TokenCharacter & "S" _
|
|
, cstPseudoToken _
|
|
) _
|
|
, Array(cstPseudoToken _
|
|
, sR1 _
|
|
, sC1 _
|
|
, sR2 _
|
|
, sC2 _
|
|
, sSheetName _
|
|
, TokenCharacter _
|
|
) _
|
|
)
|
|
|
|
Finally:
|
|
Printf = sPrintf
|
|
ScriptForge.SF_Utils._ExitFunction(cstThisSub)
|
|
Exit Function
|
|
Catch:
|
|
GoTo Finally
|
|
End Function ' SFDocuments.SF_Calc.Printf
|
|
|
|
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" _
|
|
, "ExportFilters" _
|
|
, "FileSystem" _
|
|
, "FirstCell" _
|
|
, "FirstColumn" _
|
|
, "FirstRow" _
|
|
, "Height" _
|
|
, "ImportFilters" _
|
|
, "IsAlive" _
|
|
, "IsBase" _
|
|
, "IsCalc" _
|
|
, "IsDraw" _
|
|
, "IsFormDocument" _
|
|
, "IsImpress" _
|
|
, "IsMath" _
|
|
, "IsWriter" _
|
|
, "Keywords" _
|
|
, "LastCell" _
|
|
, "LastColumn" _
|
|
, "LastRow" _
|
|
, "Range" _
|
|
, "Readonly" _
|
|
, "Region" _
|
|
, "Sheet" _
|
|
, "SheetName" _
|
|
, "Sheets" _
|
|
, "StyleFamilies" _
|
|
, "Subject" _
|
|
, "Title" _
|
|
, "Width" _
|
|
, "XCellRange" _
|
|
, "XComponent" _
|
|
, "XDocumentSettings" _
|
|
, "XSheetCellCursor" _
|
|
, "XSpreadsheet" _
|
|
)
|
|
|
|
End Function ' SFDocuments.SF_Calc.Properties
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Public Function RemoveDuplicates(Optional ByVal Range As Variant _
|
|
, Optional ByVal Columns As Variant _
|
|
, Optional ByVal Header As Variant _
|
|
, Optional ByVal CaseSensitive As Variant _
|
|
, Optional ByVal Mode As Variant _
|
|
) As String
|
|
''' Remove duplicate values from a range of values.
|
|
''' The comparison between rows is done on a subset of the columns in the range.
|
|
''' The resulting range replaces the input range, in which, either:
|
|
''' all duplicate rows are cleared from their content
|
|
''' all duplicate rows are suppressed and rows below are pushed upwards.
|
|
''' Anyway, the first copy of each set of duplicates is kept and the initial sequence is preserved.
|
|
''' Args:
|
|
''' Range: the range, as a string, from which the duplicate rows should be removed
|
|
''' Columns: an array of column numbers to compare; items are in the interval [1 .. range width]
|
|
''' Default = the first column in the range
|
|
''' Header: when True, the first row is a header row. Default = False.
|
|
''' CaseSensitive: for string comparisons. Default = False.
|
|
''' Mode: either "CLEAR" or "COMPACT" (Default)
|
|
''' For large ranges, the "COMPACT" mode is probably significantly slower.
|
|
''' Returns:
|
|
''' The resulting range as a string
|
|
''' Examples:
|
|
''' oCalc.RemoveDuplicates("Sheet1.B2:K11", Array(1, 2), Header := True, CaseSensitive := True)
|
|
|
|
Dim sRemove As String ' Return value
|
|
Dim oRangeAddress As Object ' Parsed range as an _Address object
|
|
Dim sMirrorRange As String ' Mirror of initial range
|
|
Dim lRandom As Long ' Random number to build the worksheet name
|
|
Dim sWorkSheet As String ' Name of worksheet
|
|
Dim vRows() As Variant ' Array of row numbers
|
|
Dim sRowsRange As String ' Range of the last column of the worksheet
|
|
Dim sFullMirrorRange As String ' Mirrored data + rows column
|
|
Dim sLastRowsRange As String ' Same as sRowsRange without the first cell
|
|
Dim sDuplicates As String ' Formula identifying a duplicate row
|
|
Dim lColumn As Long ' Single column number
|
|
Dim sColumn As String ' Single column name
|
|
Dim sFilter As String ' Filter formula for final compaction or clearing
|
|
|
|
Const cstThisSub = "SFDocuments.Calc.RemoveDuplicates"
|
|
Const cstSubArgs = "Range, [Columns], [Header=False], [CaseSensitive=False], [Mode=""COMPACT""|""CLEAR""]"
|
|
|
|
If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
|
|
sRemove = ""
|
|
|
|
Check:
|
|
If IsMissing(Columns) Or IsEmpty(Columns) Then Columns = Array(1)
|
|
If Not IsArray(Columns) Then Columns = Array(Columns)
|
|
If IsMissing(Header) Or IsEmpty(Header) Then Header = False
|
|
If IsMissing(CaseSensitive) Or IsEmpty(CaseSensitive) Then CaseSensitive = False
|
|
If IsMissing(Mode) Or IsEmpty(Mode) Then Mode = "COMPACT"
|
|
If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
|
|
If Not _IsStillAlive(True) Then GoTo Finally
|
|
If Not ScriptForge.SF_Utils._Validate(Range, "Range", V_STRING) Then GoTo Finally
|
|
If Not ScriptForge.SF_Utils._ValidateArray(Columns, "Columns", 1, ScriptForge.V_NUMERIC, True) Then GoTo Finally
|
|
If Not ScriptForge.SF_Utils._Validate(Header, "Header", ScriptForge.V_BOOLEAN) Then GoTo Finally
|
|
If Not ScriptForge.SF_Utils._Validate(CaseSensitive, "CaseSensitive", ScriptForge.V_BOOLEAN) Then GoTo Finally
|
|
If Not ScriptForge.SF_Utils._Validate(Mode, "Mode", V_STRING, Array("COMPACT", "CLEAR")) Then GoTo Finally
|
|
End If
|
|
|
|
Try:
|
|
' Let's assume the initial range is "$Sheet1.$B$11:$K$110" (100 rows, 10 columns, no header)
|
|
' Ignore header, consider only the effective data
|
|
If Header Then Set oRangeAddress = _Offset(Range, 1, 0, Height(Range) - 1, 0) Else Set oRangeAddress = _ParseAddress(Range)
|
|
|
|
'** Step 1: create a worksheet and copy the range in A1
|
|
lRandom = ScriptForge.SF_Session.ExecuteCalcFunction("RANDBETWEEN.NV", 1, 999999)
|
|
sWorkSheet = "SF_WORK_" & Right("000000" & lRandom, 6)
|
|
InsertSheet(sWorkSheet)
|
|
' sMirrorRange = "$SF_WORK.$A$1:$J$100"
|
|
sMirrorRange = CopyToCell(oRangeAddress, "$" & sWorkSheet & ".$A$1")
|
|
|
|
'** Step 2: add a column in the mirror with the row numbers in the initial range
|
|
' vRows = [11..110]
|
|
With oRangeAddress.XCellRange
|
|
vRows = ScriptForge.RangeInit(CLng(.RangeAddress.StartRow + 1), CLng(.RangeAddress.EndRow + 1))
|
|
End With
|
|
' sRowsRange = "$SF_WORK.$K$1:$K$100"
|
|
sRowsRange = SetArray(Offset(sMirrorRange, , Width(sMirrorRange), 1, 1), vRows())
|
|
|
|
'** Step 3: sort the mirrored data, including the row numbers column
|
|
' sFullMirrorRange = "$SF_WORK.$A$1:$K$100"
|
|
sFullMirrorRange = Offset(sMirrorRange, , , , Width(sMirrorRange) + 1)
|
|
SortRange(sFullMirrorRange, SortKeys := Columns, CaseSensitive := CaseSensitive)
|
|
|
|
'** Step 4: Filter out the row numbers containing duplicates
|
|
' sLastRowRange = "$SF_WORK.$K$2:$K$100"
|
|
sLastRowsRange = Offset(sRowsRange, 1, , Height(sRowsRange) - 1)
|
|
' If Columns = (1, 3) => sDuplicates = "=AND(TRUE;$A2=$A1;$C2=$C1)
|
|
sDuplicates = "=AND(TRUE"
|
|
For Each lColumn In Columns
|
|
sColumn = _GetColumnName(lColumn)
|
|
If CaseSensitive Then
|
|
sDuplicates = sDuplicates & ";$" & sColumn & "2=$" & sColumn & "1"
|
|
Else
|
|
sDuplicates = sDuplicates & ";UPPER($" & sColumn & "2)=UPPER($" & sColumn & "1)"
|
|
End If
|
|
Next lColumn
|
|
sDuplicates = sDuplicates & ")"
|
|
ClearValues(sLastRowsRange, sDuplicates, "ROW")
|
|
|
|
'** Step 5: Compact or clear the rows in the initial range that are not retained in the final row numbers list
|
|
' sFilter = "=ISNA(MATCH(ROW();$SF_WORK.$K$1:$K$100;0))"
|
|
sFilter = "=ISNA(MATCH(ROW();" & sRowsRange & ";0))"
|
|
Select Case UCase(Mode)
|
|
Case "COMPACT"
|
|
sRemove = CompactUp(oRangeAddress.RangeName, WholeRow := False, FilterFormula := sFilter)
|
|
If Header Then sRemove = Offset(sRemove, -1, 0, Height(sRemove) + 1)
|
|
Case "CLEAR"
|
|
ClearValues(oRangeAddress.RangeName, FilterFormula := sFilter, FilterScope := "ROW")
|
|
If Header Then sRemove = _ParseAddress(Range).RangeName Else sRemove = oRangeAddress.RangeName
|
|
End Select
|
|
|
|
'** Housekeeping
|
|
RemoveSheet(sWorkSheet)
|
|
|
|
Finally:
|
|
RemoveDuplicates = sRemove
|
|
ScriptForge.SF_Utils._ExitFunction(cstThisSub)
|
|
Exit Function
|
|
Catch:
|
|
GoTo Finally
|
|
End Function ' SFDocuments.SF_Calc.RemoveDuplicates
|
|
|
|
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 = ScriptForge.SF_Array.ConvertToDataArray(Value, IsRange := True)
|
|
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 ' SFDocuments.SF_Calc.SetArray
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Public Function SetCellStyle(Optional ByVal TargetRange As Variant _
|
|
, Optional ByVal Style As Variant _
|
|
, Optional ByVal FilterFormula As Variant _
|
|
, Optional ByVal FilterScope As Variant _
|
|
) As String
|
|
''' Apply the given cell style in the given range
|
|
''' If the cell style does not exist, an error is raised
|
|
''' The range is updated and the remainder of the sheet is left untouched
|
|
''' Either the full range is updated or a selection based on a FilterFormula
|
|
''' Args:
|
|
''' TargetRange : the range as a string that should receive a new cell style
|
|
''' Style: the style name as a string
|
|
''' FilterFormula: a Calc formula to select among the given Range
|
|
''' When left empty, all the cells of the range are formatted with the new style
|
|
''' FilterScope: "CELL" (default value), "ROW" or "COLUMN"
|
|
''' When FilterFormula is present, FilterScope is mandatory
|
|
''' Returns:
|
|
''' A string representing the updated range
|
|
''' Examples:
|
|
''' oDoc.SetCellStyle("A1:F1", "Heading 2")
|
|
''' oDoc.SetCellStype("A1:J20", "Wrong", "=(A1<0)", "CELL")
|
|
|
|
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
|
|
Dim vRanges() As Variant ' Array of filtered ranges
|
|
Dim i As Long
|
|
|
|
Const cstStyle = "CellStyles"
|
|
Const cstThisSub = "SFDocuments.Calc.SetCellStyle"
|
|
Const cstSubArgs = "TargetRange, Style, [FilterFormula=""], [FilterScope=""CELL""|""ROW""|""COLUMN""]"
|
|
|
|
If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
|
|
sSet = ""
|
|
|
|
Check:
|
|
If IsMissing(FilterFormula) Or IsEmpty(FilterFormula) Then FilterFormula = ""
|
|
If IsMissing(FilterScope) Or IsEmpty(FilterScope) Then FilterScope = "CELL"
|
|
If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
|
|
If Not _IsStillAlive() Then GoTo Finally
|
|
If Not ScriptForge.SF_Utils._Validate(TargetRange, "TargetRange", Array(V_STRING, ScriptForge.V_OBJECT)) Then GoTo Finally
|
|
' Check that the given style really exists
|
|
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, True) Then GoTo Finally
|
|
' Filter formula
|
|
If Not ScriptForge.SF_Utils._Validate(FilterFormula, "FilterFormula", V_STRING) Then GoTo Finally
|
|
If Len(FilterFormula) > 0 Then
|
|
If Not ScriptForge.SF_Utils._Validate(FilterScope, "FilterScope", V_STRING, Array("CELL", "ROW", "COLUMN")) Then GoTo Finally
|
|
Else
|
|
If Not ScriptForge.SF_Utils._Validate(FilterScope, "FilterScope", V_STRING) Then GoTo Finally
|
|
End If
|
|
End If
|
|
|
|
Try:
|
|
If VarType(TargetRange) = V_STRING Then Set oAddress = _ParseAddress(TargetRange) Else Set oAddress = TargetRange
|
|
With oAddress
|
|
If Len(FilterFormula) = 0 Then ' When the full range should be updated
|
|
.XCellRange.CellStyle = Style
|
|
Else ' When the range has to be cut in subranges
|
|
vRanges() = _ComputeFilter(oAddress, FilterFormula, UCase(FilterScope))
|
|
For i = 0 To UBound(vRanges)
|
|
vRanges(i).XCellRange.CellStyle = Style
|
|
Next i
|
|
End If
|
|
sSet = .RangeName
|
|
End With
|
|
|
|
Finally:
|
|
SetCellStyle = sSet
|
|
ScriptForge.SF_Utils._ExitFunction(cstThisSub)
|
|
Exit Function
|
|
Catch:
|
|
GoTo Finally
|
|
End Function ' SFDocuments.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.XSpreadsheet.Name)
|
|
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", Array(V_STRING, ScriptForge.V_OBJECT)) 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:
|
|
If VarType(TargetRange) = V_STRING Then Set oAddress = _ParseAddress(TargetRange) Else Set oAddress = TargetRange
|
|
With oAddress
|
|
If IsArray(Formula) Then
|
|
' Convert to data array and limit its size to the size of the initial range
|
|
vDataArray = ScriptForge.SF_Array.ConvertToDataArray(Formula, Rows := .Height, Columns := .Width)
|
|
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 ' SFDocuments.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 = ScriptForge.SF_Array.ConvertToDataArray(Value, IsRange := True, Rows := .Height, Columns := .Width)
|
|
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 ' SFDocuments.SF_Calc.SetValue
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Public Function ShiftDown(Optional ByVal Range As Variant _
|
|
, Optional ByVal WholeRow As Variant _
|
|
, Optional ByVal Rows As Variant _
|
|
) As String
|
|
''' Move a specified range and all cells below in the same columns downwards by inserting empty cells
|
|
''' The inserted cells can span whole rows or be limited to the width of the range
|
|
''' The height of the inserted area is provided by the Rows argument
|
|
''' Nothing happens if the range shift crosses one of the edges of the worksheet
|
|
''' The execution of the method has no effect on the current selection
|
|
''' Args:
|
|
''' Range: the range above which cells have to be inserted, as a string
|
|
''' WholeRow: when True (default = False), insert whole rows
|
|
''' Rows: the height of the area to insert. Default = the height of the Range argument
|
|
''' Returns:
|
|
''' A string representing the new location of the initial range
|
|
''' Examples:
|
|
''' newrange = oDoc.ShiftDown("SheetX.A1:F10") ' "$SheetX.$A$11:$F$20"
|
|
''' newrange = oDoc.ShiftDown("SheetX.A1:F10", Rows := 3) ' "$SheetX.$A$4:$F$13"
|
|
|
|
Dim sShift As String ' Return value
|
|
Dim oSourceAddress As Object ' Alias of Range as _Address
|
|
Dim lHeight As Long ' Range height
|
|
Dim oShiftAddress As Object ' com.sun.star.table.CellRangeAddress - Range adjusted to the right width
|
|
Dim lShiftMode As Long ' One of the com.sun.star.sheet.CellInsertMode enum values
|
|
|
|
Const cstThisSub = "SFDocuments.Calc.ShiftDown"
|
|
Const cstSubArgs = "Range, [WholeRow=False], [Rows]"
|
|
|
|
If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
|
|
sShift = ""
|
|
|
|
Check:
|
|
If IsMissing(WholeRow) Or IsEmpty(WholeRow) Then WholeRow = False
|
|
If IsMissing(Rows) Or IsEmpty(Rows) Then Rows = 0
|
|
If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
|
|
If Not _IsStillAlive(True) Then GoTo Finally
|
|
If Not ScriptForge.SF_Utils._Validate(Range, "Range", V_STRING) Then GoTo Finally
|
|
If Not ScriptForge.SF_Utils._Validate(WholeRow, "WholeRow", ScriptForge.V_BOOLEAN) Then GoTo Finally
|
|
If Not ScriptForge.SF_Utils._Validate(Rows, "Rows", ScriptForge.V_NUMERIC) Then GoTo Finally
|
|
End If
|
|
|
|
Try:
|
|
Set oSourceAddress = _ParseAddress(Range)
|
|
|
|
With oSourceAddress
|
|
|
|
' Manage the height of the area to shift
|
|
' The insertCells() method inserts a number of rows equal to the height of the cell range to shift
|
|
lHeight = .Height
|
|
If Rows <= 0 Then Rows = lHeight
|
|
If _LastCell(.XSpreadsheet)(1) + Rows > MAXROWS Then GoTo Catch
|
|
If Rows <> lHeight Then
|
|
Set oShiftAddress = _Offset(oSourceAddress, 0, 0, Rows, 0).XCellRange.RangeAddress
|
|
Else
|
|
Set oShiftAddress = .XCellRange.RangeAddress
|
|
End If
|
|
|
|
' Determine the shift mode
|
|
With com.sun.star.sheet.CellInsertMode
|
|
If WholeRow Then lShiftMode = .ROWS Else lShiftMode = .DOWN
|
|
End With
|
|
|
|
' Move the cells as requested. This modifies .XCellRange
|
|
.XSpreadsheet.insertCells(oShiftAddress, lShiftMode)
|
|
|
|
' Determine the receiving area
|
|
sShift = .XCellRange.AbsoluteName
|
|
|
|
End With
|
|
|
|
Finally:
|
|
ShiftDown = sShift
|
|
ScriptForge.SF_Utils._ExitFunction(cstThisSub)
|
|
Exit Function
|
|
Catch:
|
|
' When error, return the original range
|
|
If Not IsNull(oSourceAddress) Then sShift = oSourceAddress.RangeName
|
|
GoTo Finally
|
|
End Function ' SFDocuments.SF_Calc.ShiftDown
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Public Function ShiftLeft(Optional ByVal Range As Variant _
|
|
, Optional ByVal WholeColumn As Variant _
|
|
, Optional ByVal Columns As Variant _
|
|
) As String
|
|
''' Delete the leftmost columns of a specified range and move all cells at their right leftwards
|
|
''' The deleted cells can span whole columns or be limited to the height of the range
|
|
''' The width of the deleted area is provided by the Columns argument
|
|
''' The execution of the method has no effect on the current selection
|
|
''' Args:
|
|
''' Range: the range in which cells have to be erased, as a string
|
|
''' WholeColumn: when True (default = False), erase whole columns
|
|
''' Columns: the width of the area to delete.
|
|
''' Default = the width of the Range argument, it is also its maximum value
|
|
''' Returns:
|
|
''' A string representing the location of the remaining part of the initial range,
|
|
''' or the zero-length string if the whole range has been deleted
|
|
''' Examples:
|
|
''' newrange = oDoc.ShiftLeft("SheetX.G1:L10") ' """
|
|
''' newrange = oDoc.ShiftLeft("SheetX.G1:L10", Columns := 3) ' "$SheetX.$G$1:$I$10"
|
|
|
|
Dim sShift As String ' Return value
|
|
Dim oSourceAddress As Object ' Alias of Range as _Address
|
|
Dim lWidth As Long ' Range width
|
|
Dim oShiftAddress As Object ' com.sun.star.table.CellRangeAddress - Range adjusted to the right width
|
|
Dim lShiftMode As Long ' One of the com.sun.star.sheet.CellDeleteMode enum values
|
|
|
|
Const cstThisSub = "SFDocuments.Calc.ShiftLeft"
|
|
Const cstSubArgs = "Range, [WholeColumn=False], [Columns]"
|
|
|
|
If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
|
|
sShift = ""
|
|
|
|
Check:
|
|
If IsMissing(WholeColumn) Or IsEmpty(WholeColumn) Then WholeColumn = False
|
|
If IsMissing(Columns) Or IsEmpty(Columns) Then Columns = 0
|
|
If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
|
|
If Not _IsStillAlive(True) Then GoTo Finally
|
|
If Not ScriptForge.SF_Utils._Validate(Range, "Range", V_STRING) Then GoTo Finally
|
|
If Not ScriptForge.SF_Utils._Validate(WholeColumn, "WholeColumn", ScriptForge.V_BOOLEAN) Then GoTo Finally
|
|
If Not ScriptForge.SF_Utils._Validate(Columns, "Columns", ScriptForge.V_NUMERIC) Then GoTo Finally
|
|
End If
|
|
|
|
Try:
|
|
Set oSourceAddress = _ParseAddress(Range)
|
|
Set _LastParsedAddress = Nothing ' Range will be erased. Force re-parsing next time
|
|
|
|
With oSourceAddress
|
|
|
|
' Manage the width of the area to delete
|
|
' The removeRange() method erases a number of columns equal to the width of the cell range to delete
|
|
lWidth = .Width
|
|
If Columns <= 0 Then Columns = lWidth
|
|
If Columns < lWidth Then
|
|
Set oShiftAddress = _Offset(oSourceAddress, 0, 0, 0, Columns).XCellRange.RangeAddress
|
|
Else ' Columns is capped at the range width
|
|
Set oShiftAddress = .XCellRange.RangeAddress
|
|
End If
|
|
|
|
' Determine the Delete mode
|
|
With com.sun.star.sheet.CellDeleteMode
|
|
If WholeColumn Then lShiftMode = .COLUMNS Else lShiftMode = .LEFT
|
|
End With
|
|
|
|
' Move the cells as requested. This modifies .XCellRange
|
|
.XSpreadsheet.removeRange(oShiftAddress, lShiftMode)
|
|
|
|
' Determine the remaining area
|
|
If Columns < lWidth Then sShift = .XCellRange.AbsoluteName
|
|
|
|
End With
|
|
|
|
Finally:
|
|
ShiftLeft = sShift
|
|
ScriptForge.SF_Utils._ExitFunction(cstThisSub)
|
|
Exit Function
|
|
Catch:
|
|
' When error, return the original range
|
|
If Not IsNull(oSourceAddress) Then sShift = oSourceAddress.RangeName
|
|
GoTo Finally
|
|
End Function ' SFDocuments.SF_Calc.ShiftLeft
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Public Function ShiftRight(Optional ByVal Range As Variant _
|
|
, Optional ByVal WholeColumn As Variant _
|
|
, Optional ByVal Columns As Variant _
|
|
) As String
|
|
''' Move a specified range and all next cells in the same rows to the right by inserting empty cells
|
|
''' The inserted cells can span whole columns or be limited to the height of the range
|
|
''' The width of the inserted area is provided by the Columns argument
|
|
''' Nothing happens if the range shift crosses one of the edges of the worksheet
|
|
''' The execution of the method has no effect on the current selection
|
|
''' Args:
|
|
''' Range: the range before which cells have to be inserted, as a string
|
|
''' WholeColumn: when True (default = False), insert whole columns
|
|
''' Columns: the width of the area to insert. Default = the width of the Range argument
|
|
''' Returns:
|
|
''' A string representing the new location of the initial range
|
|
''' Examples:
|
|
''' newrange = oDoc.ShiftRight("SheetX.A1:F10") ' "$SheetX.$G$1:$L$10"
|
|
''' newrange = oDoc.ShiftRight("SheetX.A1:F10", Columns := 3) ' "$SheetX.$D$1:$I$10"
|
|
|
|
Dim sShift As String ' Return value
|
|
Dim oSourceAddress As Object ' Alias of Range as _Address
|
|
Dim lWidth As Long ' Range width
|
|
Dim oShiftAddress As Object ' com.sun.star.table.CellRangeAddress - Range adjusted to the right width
|
|
Dim lShiftMode As Long ' One of the com.sun.star.sheet.CellInsertMode enum values
|
|
|
|
Const cstThisSub = "SFDocuments.Calc.ShiftRight"
|
|
Const cstSubArgs = "Range, [WholeColumn=False], [Columns]"
|
|
|
|
If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
|
|
sShift = ""
|
|
|
|
Check:
|
|
If IsMissing(WholeColumn) Or IsEmpty(WholeColumn) Then WholeColumn = False
|
|
If IsMissing(Columns) Or IsEmpty(Columns) Then Columns = 0
|
|
If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
|
|
If Not _IsStillAlive(True) Then GoTo Finally
|
|
If Not ScriptForge.SF_Utils._Validate(Range, "Range", V_STRING) Then GoTo Finally
|
|
If Not ScriptForge.SF_Utils._Validate(WholeColumn, "WholeColumn", ScriptForge.V_BOOLEAN) Then GoTo Finally
|
|
If Not ScriptForge.SF_Utils._Validate(Columns, "Columns", ScriptForge.V_NUMERIC) Then GoTo Finally
|
|
End If
|
|
|
|
Try:
|
|
Set oSourceAddress = _ParseAddress(Range)
|
|
|
|
With oSourceAddress
|
|
|
|
' Manage the width of the area to Shift
|
|
' The insertCells() method inserts a number of columns equal to the width of the cell range to Shift
|
|
lWidth = .Width
|
|
If Columns <= 0 Then Columns = lWidth
|
|
If _LastCell(.XSpreadsheet)(0) + Columns > MAXCOLS Then GoTo Catch
|
|
If Columns <> lWidth Then
|
|
Set oShiftAddress = _Offset(oSourceAddress, 0, 0, 0, Columns).XCellRange.RangeAddress
|
|
Else
|
|
Set oShiftAddress = .XCellRange.RangeAddress
|
|
End If
|
|
|
|
' Determine the Shift mode
|
|
With com.sun.star.sheet.CellInsertMode
|
|
If WholeColumn Then lShiftMode = .COLUMNS Else lShiftMode = .RIGHT
|
|
End With
|
|
|
|
' Move the cells as requested. This modifies .XCellRange
|
|
.XSpreadsheet.insertCells(oShiftAddress, lShiftMode)
|
|
|
|
' Determine the receiving area
|
|
sShift = .XCellRange.AbsoluteName
|
|
|
|
End With
|
|
|
|
Finally:
|
|
ShiftRight = sShift
|
|
ScriptForge.SF_Utils._ExitFunction(cstThisSub)
|
|
Exit Function
|
|
Catch:
|
|
' When error, return the original range
|
|
If Not IsNull(oSourceAddress) Then sShift = oSourceAddress.RangeName
|
|
GoTo Finally
|
|
End Function ' SFDocuments.SF_Calc.ShiftRight
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Public Function ShiftUp(Optional ByVal Range As Variant _
|
|
, Optional ByVal WholeRow As Variant _
|
|
, Optional ByVal Rows As Variant _
|
|
) As String
|
|
''' Delete the topmost rows of a specified range and move all cells below upwards
|
|
''' The deleted cells can span whole rows or be limited to the width of the range
|
|
''' The height of the deleted area is provided by the Rows argument
|
|
''' The execution of the method has no effect on the current selection
|
|
''' Args:
|
|
''' Range: the range in which cells have to be erased, as a string
|
|
''' WholeRow: when True (default = False), erase whole rows
|
|
''' Rows: the height of the area to delete.
|
|
''' Default = the height of the Range argument, it is also its maximum value
|
|
''' Returns:
|
|
''' A string representing the location of the remaining part of the initial range,
|
|
''' or the zero-length string if the whole range has been deleted
|
|
''' Examples:
|
|
''' newrange = oDoc.ShiftUp("SheetX.G1:L10") ' ""
|
|
''' newrange = oDoc.ShiftUp("SheetX.G1:L10", Rows := 3) ' "$SheetX.$G$1:$I$10"
|
|
|
|
Dim sShift As String ' Return value
|
|
Dim oSourceAddress As Object ' Alias of Range as _Address
|
|
Dim lHeight As Long ' Range height
|
|
Dim oShiftAddress As Object ' com.sun.star.table.CellRangeAddress - Range adjusted to the right height
|
|
Dim lShiftMode As Long ' One of the com.sun.star.sheet.CellDeleteMode enum values
|
|
|
|
Const cstThisSub = "SFDocuments.Calc.ShiftUp"
|
|
Const cstSubArgs = "Range, [WholeRow=False], [Rows]"
|
|
|
|
If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
|
|
sShift = ""
|
|
|
|
Check:
|
|
If IsMissing(WholeRow) Or IsEmpty(WholeRow) Then WholeRow = False
|
|
If IsMissing(Rows) Or IsEmpty(Rows) Then Rows = 0
|
|
If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
|
|
If Not _IsStillAlive(True) Then GoTo Finally
|
|
If Not ScriptForge.SF_Utils._Validate(Range, "Range", V_STRING) Then GoTo Finally
|
|
If Not ScriptForge.SF_Utils._Validate(WholeRow, "WholeRow", ScriptForge.V_BOOLEAN) Then GoTo Finally
|
|
If Not ScriptForge.SF_Utils._Validate(Rows, "Rows", ScriptForge.V_NUMERIC) Then GoTo Finally
|
|
End If
|
|
|
|
Try:
|
|
Set oSourceAddress = _ParseAddress(Range)
|
|
Set _LastParsedAddress = Nothing ' Range will be erased. Force re-parsing next time
|
|
|
|
With oSourceAddress
|
|
|
|
' Manage the height of the area to delete
|
|
' The removeRange() method erases a number of rows equal to the height of the cell range to delete
|
|
lHeight = .Height
|
|
If Rows <= 0 Then Rows = lHeight
|
|
If Rows < lHeight Then
|
|
Set oShiftAddress = _Offset(oSourceAddress, 0, 0, Rows, 0).XCellRange.RangeAddress
|
|
Else ' Rows is capped at the range height
|
|
Set oShiftAddress = .XCellRange.RangeAddress
|
|
End If
|
|
|
|
' Determine the Delete mode
|
|
With com.sun.star.sheet.CellDeleteMode
|
|
If WholeRow Then lShiftMode = .ROWS Else lShiftMode = .UP
|
|
End With
|
|
|
|
' Move the cells as requested. This modifies .XCellRange
|
|
.XSpreadsheet.removeRange(oShiftAddress, lShiftMode)
|
|
|
|
' Determine the remaining area
|
|
If Rows < lHeight Then sShift = .XCellRange.AbsoluteName
|
|
|
|
End With
|
|
|
|
Finally:
|
|
ShiftUp = sShift
|
|
ScriptForge.SF_Utils._ExitFunction(cstThisSub)
|
|
Exit Function
|
|
Catch:
|
|
' When error, return the original range
|
|
If Not IsNull(oSourceAddress) Then sShift = oSourceAddress.RangeName
|
|
GoTo Finally
|
|
End Function ' SFDocuments.SF_Calc.ShiftUp
|
|
|
|
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 any number of columns/rows. The sorting order may vary by column/row
|
|
''' If the number of sort keys is > 3 then the range is sorted several times, by groups of 3 keys,
|
|
''' starting from the last key. In this context the algorithm used by Calc to sort ranges
|
|
''' is presumed STABLE, i.e. it maintains the relative order of records with equal keys.
|
|
'''
|
|
''' 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 oSortRange As Object ' The area to sort as an _Address object
|
|
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 lSort As Long ' Counter for sub-sorts
|
|
Dim lKeys As Long ' UBound of SortKeys
|
|
Dim lKey As Long ' Actual index in SortKeys
|
|
Dim i As Long, j As Long
|
|
Const cstMaxKeys = 3 ' Maximum number of keys allowed in a single sorting step
|
|
|
|
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", ScriptForge.V_BOOLEAN) Then GoTo Finally
|
|
If Not ScriptForge.SF_Utils._Validate(CaseSensitive, "CaseSensitive", ScriptForge.V_BOOLEAN) Then GoTo Finally
|
|
If Not ScriptForge.SF_Utils._Validate(SortColumns, "SortColumns", ScriptForge.V_BOOLEAN) Then GoTo Finally
|
|
End If
|
|
Set oRangeAddress = _ParseAddress(Range)
|
|
If Len(DestinationCell) > 0 Then Set oDestRange = _ParseAddress(DestinationCell) Else Set oDestRange = Nothing
|
|
|
|
Try:
|
|
' Initialize a generic sort descriptor
|
|
Set oRange = oRangeAddress.XCellRange
|
|
vSortDescriptor = oRange.createSortDescriptor ' Makes a generic sort descriptor for ranges
|
|
vSortDescriptor = ScriptForge.SF_Utils._SetPropertyValue(vSortDescriptor, "IsSortColumns", SortColumns)
|
|
vSortDescriptor = ScriptForge.SF_Utils._SetPropertyValue(vSortDescriptor, "ContainsHeader", ContainsHeader)
|
|
vSortDescriptor = ScriptForge.SF_Utils._SetPropertyValue(vSortDescriptor, "BindFormatsToContent", True)
|
|
vSortDescriptor = ScriptForge.SF_Utils._SetPropertyValue(vSortDescriptor, "IsUserListEnabled", False)
|
|
|
|
' Sort by keys group
|
|
' If keys = (1, 2, 3, 4, 5) then groups = (4, 5), (1, 2, 3)
|
|
lKeys = UBound(SortKeys)
|
|
lSort = Int(lKeys / cstMaxKeys)
|
|
Set oSortRange = oRangeAddress
|
|
|
|
For j = lSort To 0 Step -1 ' Sort first on last sort keys
|
|
|
|
' The 1st sort must consider the destination area. Next sorts are done on the destination area
|
|
If Len(DestinationCell) = 0 Or j < lSort Then
|
|
vSortDescriptor = ScriptForge.SF_Utils._SetPropertyValue(vSortDescriptor, "CopyOutputData", False)
|
|
vSortDescriptor = ScriptForge.SF_Utils._SetPropertyValue(vSortDescriptor, "OutputPosition", Nothing)
|
|
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
|
|
|
|
' Define the sorting keys
|
|
vSortFields = DimArray(lKeys Mod cstMaxKeys)
|
|
For i = 0 To UBound(vSortFields)
|
|
vSortFields(i) = New com.sun.star.table.TableSortField
|
|
lKey = j * cstMaxKeys + i
|
|
If lKey > UBound(SortOrder) Then sOrder = "" Else sOrder = SortOrder(lKey)
|
|
If Len(sOrder) = 0 Then sOrder = "ASC"
|
|
With vSortFields(i)
|
|
.Field = SortKeys(lKey) - 1
|
|
.IsAscending = ( UCase(sOrder) = "ASC" )
|
|
.IsCaseSensitive = CaseSensitive
|
|
End With
|
|
Next i
|
|
lKeys = lKeys - UBound(vSortFields) - 1
|
|
|
|
' Associate the keys and the descriptor, and sort
|
|
vSortDescriptor = ScriptForge.SF_Utils._SetPropertyValue(vSortDescriptor, "SortFields", vSortFields)
|
|
oSortRange.XCellRange.sort(vSortDescriptor)
|
|
|
|
' Next loop, if any, is done on the destination area
|
|
If Len(DestinationCell) > 0 And j = lSort And lSort > 0 Then Set oSortRange = _Offset(oDestRange, 0, 0, oRangeAddress.Height, oRangeAddress.Width)
|
|
|
|
Next j
|
|
|
|
' 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 ' SFDocuments.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 ExportFilters() As Variant
|
|
ExportFilters = [_Super].GetProperty("ExportFilters")
|
|
End Property ' SFDocuments.SF_Calc.ExportFilters
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Property Get FileSystem() As String
|
|
FileSystem = [_Super].GetProperty("FileSystem")
|
|
End Property ' SFDocuments.SF_Calc.FileSystem
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Property Get ImportFilters() As Variant
|
|
ImportFilters = [_Super].GetProperty("ImportFilters")
|
|
End Property ' SFDocuments.SF_Calc.ImportFilters
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Property Get IsAlive() As Boolean
|
|
IsAlive = [_Super].GetProperty("IsAlive")
|
|
End Property ' SFDocuments.SF_Calc.IsAlive
|
|
|
|
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 IsFormDocument() As Boolean
|
|
IsFormDocument = [_Super].GetProperty("IsFormDocument")
|
|
End Property ' SFDocuments.SF_Writer.IsFormDocument
|
|
|
|
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 StyleFamilies() As Variant
|
|
StyleFamilies = [_Super].GetProperty("StyleFamilies")
|
|
End Property ' SFDocuments.SF_Calc.StyleFamilies
|
|
|
|
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 -----------------------------------------------------------------------------
|
|
Property Get XDocumentSettings() As Variant
|
|
XDocumentSettings = [_Super].GetProperty("XDocumentSettings")
|
|
End Property ' SFDocuments.SF_Calc.XDocumentSettings
|
|
|
|
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 ContextMenus(Optional ByVal ContextMenuName As Variant _
|
|
, Optional ByVal SubmenuChar As Variant _
|
|
) As Variant
|
|
ContextMenus = [_Super].ContextMenus(ContextMenuName, SubmenuChar)
|
|
End Function ' SFDocuments.SF_Calc.ContextMenus
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Public Function CreateMenu(Optional ByVal MenuHeader As Variant _
|
|
, Optional ByVal Before As Variant _
|
|
, Optional ByVal SubmenuChar As Variant _
|
|
) As Object
|
|
Set CreateMenu = [_Super].CreateMenu(MenuHeader, Before, SubmenuChar)
|
|
End Function ' SFDocuments.SF_Calc.CreateMenu
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Public Sub DeleteStyles(Optional ByVal Family As Variant _
|
|
, Optional ByRef StylesList As Variant _
|
|
)
|
|
[_Super].DeleteStyles(Family, StylesList)
|
|
End Sub ' SFDocuments.SF_Calc.DeleteStyles
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Public Sub Echo(Optional ByVal EchoOn As Variant _
|
|
, Optional ByVal Hourglass As Variant _
|
|
)
|
|
[_Super].Echo(EchoOn, Hourglass)
|
|
End Sub ' SFDocuments.SF_Calc.Echo
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Public Function ExportAsPDF(Optional ByVal FileName As Variant _
|
|
, Optional ByVal Overwrite As Variant _
|
|
, Optional ByVal Pages As Variant _
|
|
, Optional ByVal Password As Variant _
|
|
, Optional ByVal Watermark As Variant _
|
|
) As Boolean
|
|
ExportAsPDF = [_Super].ExportAsPDF(FileName, Overwrite, Pages, Password, Watermark)
|
|
End Function ' SFDocuments.SF_Calc.ExportAsPDF
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Public Sub ImportStylesFromFile(Optional FileName As Variant _
|
|
, Optional ByRef Families As Variant _
|
|
, Optional ByVal Overwrite As variant _
|
|
) As Variant
|
|
[_Super]._ImportStylesFromFile(FileName, Families, Overwrite)
|
|
End Sub ' SFDocuments.SF_Calc.ImportStylesFromFile
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Public Function RemoveMenu(Optional ByVal MenuHeader As Variant) As Boolean
|
|
RemoveMenu = [_Super].RemoveMenu(MenuHeader)
|
|
End Function ' SFDocuments.SF_Calc.RemoveMenu
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Public Sub RunCommand(Optional ByVal Command As Variant _
|
|
, ParamArray Args As Variant _
|
|
)
|
|
[_Super].RunCommand(Command, Args)
|
|
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 -----------------------------------------------------------------------------
|
|
Public Function Styles(Optional ByVal Family As Variant _
|
|
, Optional ByVal NamePattern As variant _
|
|
, Optional ByVal Used As variant _
|
|
, Optional ByVal UserDefined As Variant _
|
|
, Optional ByVal ParentStyle As Variant _
|
|
, Optional ByVal Category As Variant _
|
|
) As Variant
|
|
Styles = [_Super].Styles(Family, NamePattern, Used, UserDefined, ParentStyle, Category)
|
|
End Function ' SFDocuments.SF_Calc.Styles
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Public Function Toolbars(Optional ByVal ToolbarName As Variant) As Variant
|
|
Toolbars = [_Super].Toolbars(ToolbarName)
|
|
End Function ' SFDocuments.SF_Calc.Toolbars
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Public Function XStyle(Optional ByVal Family As Variant _
|
|
, Optional ByVal StyleName As variant _
|
|
) As Object
|
|
Set XStyle = [_Super].XStyle(Family, StyleName)
|
|
End Function ' SFDocuments.SF_Calc.XStyle
|
|
|
|
REM =========================================================== PRIVATE FUNCTIONS
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Private Sub _ClearRange(ByVal psTarget As String _
|
|
, Optional ByVal Range As Variant _
|
|
, Optional FilterFormula As Variant _
|
|
, Optional FilterScope As Variant _
|
|
)
|
|
''' Clear the given range with the given options
|
|
''' The range may be filtered by a formula for a selective clearance
|
|
''' Arguments checking is done in this Sub, not in the calling one
|
|
''' Args:
|
|
''' psTarget: "All", "Formats" or "Values"
|
|
''' Range: the range to clear as a string
|
|
''' FilterFormula: a selection of cells based on a Calc formula
|
|
''' When left empty, all the cells of the range are cleared
|
|
''' psFilterScope: "CELL", "ROW" or "COLUMN"
|
|
|
|
Dim lClear As Long ' A combination of com.sun.star.sheet.CellFlags
|
|
Dim oRange As Object ' Alias of Range
|
|
Dim vRanges() As Variant ' Array of subranges resulting from the application of the filter
|
|
Dim i As Long
|
|
|
|
Dim cstThisSub As String : cstThisSub = "SFDocuments.Calc.Clear" & psTarget
|
|
Const cstSubArgs = "Range, [FilterFormula=""], [FilterScope=""CELL""|""ROW""|""COLUMN""]"
|
|
|
|
If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
|
|
|
|
Check:
|
|
If IsMissing(FilterFormula) Or IsEmpty(FilterFormula) Then FilterFormula = ""
|
|
If IsMissing(FilterScope) Or IsEmpty(FilterScope) Then FilterScope = "CELL"
|
|
If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
|
|
If Not _IsStillAlive() Then GoTo Finally
|
|
If Not ScriptForge.SF_Utils._Validate(Range, "Range", Array(V_STRING, ScriptForge.V_OBJECT)) Then GoTo Finally
|
|
If Not ScriptForge.SF_Utils._Validate(FilterFormula, "FilterFormula", V_STRING) Then GoTo Finally
|
|
If Len(FilterFormula) > 0 Then
|
|
If Not ScriptForge.SF_Utils._Validate(FilterScope, "FilterScope", V_STRING, Array("CELL", "ROW", "COLUMN")) Then GoTo Finally
|
|
Else
|
|
If Not ScriptForge.SF_Utils._Validate(FilterScope, "FilterScope", V_STRING) Then GoTo Finally
|
|
End If
|
|
End If
|
|
|
|
Try:
|
|
With com.sun.star.sheet.CellFlags
|
|
Select Case psTarget
|
|
Case "All"
|
|
lClear = .VALUE + .DATETIME + .STRING + .ANNOTATION + .FORMULA _
|
|
+ .HARDATTR + .STYLES + .OBJECTS + .EDITATTR + .FORMATTED
|
|
Case "Formats"
|
|
lClear = .HARDATTR + .STYLES + .EDITATTR + .FORMATTED
|
|
Case "Values"
|
|
lClear = .VALUE + .DATETIME + .STRING + .FORMULA
|
|
End Select
|
|
End With
|
|
|
|
If VarType(Range) = V_STRING Then Set oRange = _ParseAddress(Range) Else Set oRange = Range
|
|
|
|
' Without filter, the whole range is cleared
|
|
' Otherwise the filter cuts the range in subranges and clears them one by one
|
|
If Len(FilterFormula) = 0 Then
|
|
oRange.XCellRange.clearContents(lClear)
|
|
Else
|
|
vRanges() = _ComputeFilter(oRange, FilterFormula, UCase(FilterScope))
|
|
For i = 0 To UBound(vRanges)
|
|
vRanges(i).XCellRange.clearContents(lClear)
|
|
Next i
|
|
End If
|
|
|
|
Finally:
|
|
ScriptForge.SF_Utils._ExitFunction(cstThisSub)
|
|
Exit Sub
|
|
Catch:
|
|
GoTo Finally
|
|
End Sub ' SFDocuments.SF_Calc._ClearRange
|
|
|
|
REM -----------------------------------------------------------------------------
|
|
Private Function _ComputeFilter(ByRef poRange As Object _
|
|
, ByVal psFilterFormula As String _
|
|
, ByVal psFilterScope As String _
|
|
) As Variant
|
|
''' Compute in the given range the cells, rows or columns for which
|
|
''' the given formula returns TRUE
|
|
''' Args:
|
|
''' poRange: the range on which to compute the filter as an _Address type
|
|
''' psFilterFormula: the formula to be applied on each row, column or cell
|
|
''' psFilterSCope: "ROW", "COLUMN" or "CELL"
|
|
''' Returns:
|
|
''' An array of ranges as objects of type _Address
|
|
|
|
Dim vRanges As Variant ' Return value
|
|
Dim oRange As Object ' A single vRanges() item
|
|
Dim lLast As Long ' Last used row or column number in the sheet containing Range
|
|
Dim oFormulaRange As _Address ' Range where the FilterFormula must be stored
|
|
Dim sFormulaDirection As String ' Either V(ertical), H(orizontal) or B(oth)
|
|
Dim vDataArray As Variant ' DataArray compatible with .DataArray UNO property
|
|
Dim vFilter As Variant ' Array of Boolean values indicating which rows should be erased
|
|
Dim bFilter As Boolean ' A single item in vFilter
|
|
Dim iDims As Integer ' Number of dimensions of vFilter()
|
|
Dim lLower As Long ' Lower level of contiguous True filter values
|
|
Dim lUpper As Long ' Upper level of contiguous True filter values
|
|
Dim i As Long, j As Long
|
|
|
|
Check:
|
|
' Error handling is determined by the calling method
|
|
vRanges = Array()
|
|
|
|
Try:
|
|
With poRange
|
|
|
|
' Compute the range where to apply the formula
|
|
' Determine the direction of the range containing the formula vertical, horizontal or both
|
|
Select Case psFilterScope
|
|
Case "ROW"
|
|
lLast = LastColumn(.SheetName)
|
|
' Put formulas as a single column in the unused area at the right of the range to filter
|
|
Set oFormulaRange = _Offset(poRange, 0, lLast - .XCellRange.RangeAddress.StartColumn + 1, 0, 1)
|
|
sFormulaDirection = "V"
|
|
Case "COLUMN"
|
|
lLast = LastRow(.SheetName)
|
|
' Put formulas as a single row in the unused area at the bottom of the range to filter
|
|
Set oFormulaRange = _Offset(poRange, lLast - .XCellRange.RangeAddress.StartRow + 1, 0, 1, 0)
|
|
sFormulaDirection = "H"
|
|
Case "CELL"
|
|
lLast = LastRow(.SheetName)
|
|
' Put formulas as a matrix in the unused area at the bottom of the range to filter
|
|
Set oFormulaRange = _Offset(poRange, lLast - .XCellRange.RangeAddress.StartRow + 1, 0, 0, 0)
|
|
sFormulaDirection = "B"
|
|
If oFormulaRange.Width = 1 Then
|
|
sFormulaDirection = "V"
|
|
ElseIf oFormulaRange.Height = 1 Then
|
|
sFormulaDirection = "H"
|
|
End If
|
|
End Select
|
|
|
|
' Apply the formula and get the result as an array of Boolean values. Clean up
|
|
SetFormula(oFormulaRange, psFilterFormula)
|
|
vDataArray = oFormulaRange.XCellRange.getDataArray()
|
|
vFilter = ScriptForge.SF_Array.ConvertFromDataArray(vDataArray)
|
|
iDims = ScriptForge.SF_Array.CountDims(vFilter)
|
|
ClearAll(oFormulaRange)
|
|
|
|
' Convert the filter values (0 = False, 1 = True) to a set of ranges
|
|
Select Case iDims
|
|
Case -1 ' Scalar
|
|
If vFilter = 1 Then vRanges = ScriptForge.SF_Array.Append(vRanges, poRange)
|
|
Case 0 ' Empty array
|
|
' Nothing to do
|
|
Case 1, 2 ' Vector or Array
|
|
' Strategy: group contiguous applicable rows/columns to optimize heavy operations like CompactUp, CompactLeft
|
|
' Stack the contiguous ranges of True values in vRanges()
|
|
|
|
' To manage vector and array with same code, setup a single fictitious loop when vector, otherwise scan array by row
|
|
For i = 0 To Iif(iDims = 1, 0, UBound(vFilter, 1))
|
|
lLower = -1 : lUpper = -1
|
|
|
|
For j = 0 To UBound(vFilter, iDims)
|
|
If iDims = 1 Then bFilter = CBool(vFilter(j)) Else bFilter = CBool(vFilter(i, j))
|
|
If j = UBound(vFilter, iDims) And bFilter Then ' Don't forget the last item
|
|
If lLower < 0 Then lLower = j
|
|
lUpper = j
|
|
ElseIf Not bFilter Then
|
|
If lLower >= 0 Then lUpper = j - 1
|
|
ElseIf bFilter Then
|
|
If lLower < 0 Then lLower = j
|
|
End If
|
|
' Determine the next applicable range when one found and limit reached
|
|
If lUpper > -1 Then
|
|
If sFormulaDirection = "V" Then ' ROW
|
|
Set oRange = _Offset(poRange, lLower, 0, lUpper - lLower + 1, 0)
|
|
ElseIf sFormulaDirection = "H" Then ' COLUMN
|
|
Set oRange = _Offset(poRange, 0, lLower, 0, lUpper - lLower + 1)
|
|
Else ' CELL
|
|
Set oRange = _Offset(poRange, i, lLower, 1, lUpper - lLower + 1)
|
|
End If
|
|
If Not IsNull(oRange) Then vRanges = ScriptForge.SF_Array.Append(vRanges, oRange)
|
|
lLower = -1 : lUpper = -1
|
|
End If
|
|
Next j
|
|
|
|
Next i
|
|
Case Else
|
|
' Should not happen
|
|
End Select
|
|
|
|
End With
|
|
|
|
Finally:
|
|
_ComputeFilter = vRanges()
|
|
Exit Function
|
|
End Function ' SFDocuments.SF_Calc._ComputeFilter
|
|
|
|
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 ' SFDocuments.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,..16384) into its letter counterpart (range 'A', 'B',..'XFD').
|
|
''' Args:
|
|
''' ColumnNumber: the column number, must be in the interval 1 ... 16384
|
|
''' Returns:
|
|
''' a string representation of the column name, in range 'A'..'XFD'
|
|
''' 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:
|
|
sCol = ""
|
|
lDiv = plColumnNumber
|
|
Do While lDiv > 0
|
|
lMod = (lDiv - 1) Mod 26
|
|
sCol = Chr(65 + lMod) & sCol
|
|
lDiv = (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 ' SFDocuments.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 ~ or *
|
|
''' Returns:
|
|
''' An object of type _Address
|
|
''' Exceptions:
|
|
''' CALCADDRESSERROR ' Address could not be parsed to a valid address
|
|
|
|
Dim oAddress As Object ' Return value
|
|
Dim sAddress As String ' Alias of psAddress
|
|
Dim vRangeName As Variant ' Array Sheet/Range
|
|
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
|
|
|
|
' If psAddress has already been parsed, get the result back
|
|
If Not IsNull(_LastParsedAddress) Then
|
|
' Given argument must contain an explicit reference to a sheet
|
|
If (InStr(psAddress, "~.") = 0 And InStr(psAddress, ".") > 0 And psAddress = _LastParsedAddress.RawAddress) _
|
|
Or psAddress = _LastParsedAddress.RangeName Then
|
|
Set _ParseAddress = _LastParsedAddress
|
|
Exit Function
|
|
Else
|
|
Set _LastParsedAddress = Nothing
|
|
End If
|
|
End If
|
|
|
|
' Reinitialize a new _Address object
|
|
Set oAddress = New _Address
|
|
With oAddress
|
|
sSheet = "" : sRange = ""
|
|
.SheetName = "" : .RangeName = ""
|
|
|
|
.ObjectType = CALCREFERENCE
|
|
.ServiceName = SERVICEREFERENCE
|
|
.RawAddress = psAddress
|
|
Set .XSpreadSheet = Nothing : Set .XCellRange = Nothing
|
|
|
|
' Remove leading "$' when followed with an apostrophe
|
|
If Left(psAddress, 2) = "$'" Then sAddress = Mid(psAddress, 2) Else sAddress = psAddress
|
|
' Split in sheet and range components on dot not enclosed in single quotes
|
|
vRangeName = ScriptForge.SF_String.SplitNotQuoted(sAddress, Delimiter := ".", QuoteChar := "'")
|
|
sSheet = ScriptForge.SF_String.Unquote(Replace(vRangeName(0), "''", "\'"), QuoteChar := "'")
|
|
' Keep a leading "$" in the sheet name only if name enclosed in single quotes
|
|
' Notes:
|
|
' sheet names may contain "$" (even "$" is a valid sheet name), named ranges must not
|
|
' sheet names may contain apostrophes (except in 1st and last positions), range names must not
|
|
If Left(vRangeName(0), 2) <> "'$" And Left(sSheet, 1) = "$" And Len(sSheet) > 1 Then sSheet = Mid(sSheet, 2)
|
|
If UBound(vRangeName) > 0 Then sRange = vRangeName(1)
|
|
|
|
' 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 = .XCellRange.AbsoluteName
|
|
.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
|
|
|
|
' Store last parsed address for reuse
|
|
Set _LastParsedAddress = oAddress
|
|
|
|
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 oAddress As Object ' _Address type for range description
|
|
Dim oCursor As Object ' com.sun.star.sheet.XSheetCellCursor
|
|
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 UCase(psProperty)
|
|
Case UCase("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 UCase("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 UCase("FirstCell"), UCase("FirstRow"), UCase("FirstColumn") _
|
|
, UCase("LastCell"), UCase("LastColumn"), UCase("LastRow") _
|
|
, UCase("SheetName")
|
|
If IsMissing(pvArg) Or IsEmpty(pvArg) Then ' Avoid errors when instance is watched in Basic IDE
|
|
If InStr(UCase(psProperty), "CELL") > 0 Then _PropertyGet = "" Else _PropertyGet = -1
|
|
Else
|
|
If Not ScriptForge.SF_Utils._Validate(pvArg, "Range", V_STRING) Then GoTo Finally
|
|
Set oAddress = _ParseAddress(pvArg)
|
|
With oAddress.XCellRange
|
|
Select Case UCase(psProperty)
|
|
Case UCase("FirstCell")
|
|
_PropertyGet = A1Style(.RangeAddress.StartRow + 1, .RangeAddress.StartColumn + 1, , , oAddress.XSpreadsheet.Name)
|
|
Case UCase("FirstColumn") : _PropertyGet = CLng(.RangeAddress.StartColumn + 1)
|
|
Case UCase("FirstRow") : _PropertyGet = CLng(.RangeAddress.StartRow + 1)
|
|
Case UCase("LastCell")
|
|
_PropertyGet = A1Style(.RangeAddress.EndRow + 1, .RangeAddress.EndColumn + 1, , , oAddress.XSpreadsheet.Name)
|
|
Case UCase("LastColumn") : _PropertyGet = CLng(.RangeAddress.EndColumn + 1)
|
|
Case UCase("LastRow") : _PropertyGet = CLng(.RangeAddress.EndRow + 1)
|
|
Case UCase("SheetName") : _PropertyGet = oAddress.XSpreadsheet.Name
|
|
End Select
|
|
End With
|
|
End If
|
|
Case UCase("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 UCase("Region")
|
|
If IsMissing(pvArg) Or IsEmpty(pvArg) Then
|
|
_PropertyGet = ""
|
|
Else
|
|
If Not ScriptForge.SF_Utils._Validate(pvArg, "Range", V_STRING) Then GoTo Finally
|
|
Set oAddress = _ParseAddress(pvArg)
|
|
With oAddress
|
|
Set oCursor = .XSpreadsheet.createCursorByRange(.XCellRange)
|
|
oCursor.collapseToCurrentRegion()
|
|
_PropertyGet = oCursor.AbsoluteName
|
|
End With
|
|
End If
|
|
Case UCase("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 UCase("Sheets")
|
|
_PropertyGet = _Component.getSheets.getElementNames()
|
|
Case UCase("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 UCase("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 UCase("XSheetCellCursor")
|
|
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 oAddress = _ParseAddress(pvArg)
|
|
Set _PropertyGet = oAddress.XSpreadsheet.createCursorByRange(oAddress.XCellRange)
|
|
End If
|
|
Case UCase("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 _QuoteSheetName(ByVal psSheetName As String) As String
|
|
''' Return the given sheet name surrounded with single quotes
|
|
''' when required to insert the sheet name into a Calc formula
|
|
''' Enclosed single quotes are doubled
|
|
''' Args:
|
|
''' psSheetName: the name to quote
|
|
''' Returns:
|
|
''' The quoted or unchanged sheet name
|
|
|
|
Dim sSheetName As String ' Return value
|
|
Dim i As Long
|
|
|
|
Try:
|
|
' Surround the sheet name with single quotes when required by the presence of single quotes
|
|
If InStr(psSheetName, "'") > 0 Then
|
|
sSheetName = "'" & Replace(psSheetName, "'", "''") & "'"
|
|
Else
|
|
' Surround the sheet name with single quotes when required by the presence of at least one of the special characters
|
|
sSheetName = psSheetName
|
|
For i = 1 To Len(cstSPECIALCHARS)
|
|
If InStr(sSheetName, Mid(cstSPECIALCHARS, i, 1)) > 0 Then
|
|
sSheetName = "'" & sSheetName & "'"
|
|
Exit For
|
|
End If
|
|
Next i
|
|
End If
|
|
|
|
Finally:
|
|
_QuoteSheetName = sSheetName
|
|
Exit Function
|
|
End Function ' SFDocuments.SF_Calc._QuoteSheetName
|
|
|
|
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 _
|
|
, Optional ByVal pvResetSheet 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
|
|
''' pvResetSheet: if True, return in pvSheetName the correct (case-sensitive) sheet name (default = False)
|
|
''' 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 lSheet As Long ' Index in 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
|
|
If IsMissing(pvResetSheet) Or IsEmpty(pvResetSheet) Then pvResetSheet = 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
|
|
' ScriptForge.SF_String.FindRegex(sAddress, "^'[^\[\]*?:\/\\]+'")
|
|
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
|
|
If pvResetSheet Then
|
|
lSheet = ScriptForge.SF_Array.IndexOf(vSheets, pvSheetName, CaseSensitive := False)
|
|
pvSheetName = vSheets(lSheet)
|
|
End If
|
|
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 -----------------------------------------------------------------------------
|
|
Private Function _ValidateSheetName(ByRef psSheetName As String _
|
|
, ByVal psArgName As String _
|
|
) As Boolean
|
|
''' Check the validity of the sheet name:
|
|
''' A sheet name - must not be empty
|
|
''' - must not contain next characters: []*?:/\
|
|
''' - must not use ' (the apostrophe) as first or last character
|
|
''' Args:
|
|
''' psSheetName: the name to check
|
|
''' psArgName: the name of the argument to appear in error messages
|
|
''' Returns:
|
|
''' True when the sheet name is valid
|
|
''' Exceptions:
|
|
''' CALCADDRESSERROR ' Sheet name could not be parsed to a valid name
|
|
|
|
Dim bValid As Boolean ' Return value
|
|
|
|
Try:
|
|
bValid = ( Len(psSheetName) > 0 )
|
|
If bValid Then bValid = ( Left(psSheetName, 1) <> "'" And Right(psSheetName, 1) <> "'" )
|
|
If bValid Then bValid = ( Len(ScriptForge.SF_String.FindRegex(psSheetName, "^[^\[\]*?:\/\\]+$", 1, CaseSensitive := False)) > 0 )
|
|
If Not bValid Then GoTo CatchSheet
|
|
|
|
Finally:
|
|
_ValidateSheetName = bValid
|
|
Exit Function
|
|
CatchSheet:
|
|
ScriptForge.SF_Exception.RaiseFatal(CALCADDRESSERROR, psArgName, psSheetName _
|
|
, "Document", [_Super]._FileIdent())
|
|
GoTo Finally
|
|
End Function ' SFDocuments.SF_Calc._ValidateSheetName
|
|
|
|
REM ============================================ END OF SFDOCUMENTS.SF_CALC
|
|
</script:module> |