diff options
Diffstat (limited to 'wizards/source/sfdocuments/SF_Calc.xba')
| -rw-r--r-- | wizards/source/sfdocuments/SF_Calc.xba | 4893 |
1 files changed, 4893 insertions, 0 deletions
diff --git a/wizards/source/sfdocuments/SF_Calc.xba b/wizards/source/sfdocuments/SF_Calc.xba new file mode 100644 index 0000000000..a14be220ef --- /dev/null +++ b/wizards/source/sfdocuments/SF_Calc.xba @@ -0,0 +1,4893 @@ +<?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) 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) 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) 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) 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) Then GoTo Finally + Set oXForm = oForms.getByName(Form) + Else ' Find the form by index + If Form < 0 Or Form >= oForms.Count Then GoTo CatchNotFound + Set oXForm = oForms.getByIndex(Form) + End If + ' Create the new Form class instance + Set oForm = SF_Register._NewForm(oXForm) + With oForm + Set .[_Parent] = [Me] + ._SheetName = SheetName + ._FormType = ISCALCFORM + Set ._Component = _Component + ._Initialize() + End With + Set Forms = oForm + End If + +Finally: + ScriptForge.SF_Utils._ExitFunction(cstThisSub) + Exit Function +Catch: + GoTo Finally +CatchNotFound: + ScriptForge.SF_Exception.RaiseFatal(CALCFORMNOTFOUNDERROR, Form, _FileIdent()) +End Function ' SFDocuments.SF_Calc.Forms + +REM ----------------------------------------------------------------------------- +Function GetColumnName(Optional ByVal ColumnNumber As Variant) As String +''' Convert a column number (range 1, 2,..1024) into its letter counterpart (range 'A', 'B',..'AMJ'). +''' Args: +''' ColumnNumber: the column number, must be in the interval 1 ... 1024 +''' Returns: +''' a string representation of the column name, in range 'A'..'AMJ' +''' If ColumnNumber is not in the allowed range, returns a zero-length string +''' Example: +''' MsgBox oDoc.GetColumnName(1022) ' "AMH" +''' Adapted from a Python function by sundar nataraj +''' http://stackoverflow.com/questions/23861680/convert-spreadsheet-number-to-column-letter + +Dim sCol As String ' Return value +Const cstThisSub = "SFDocuments.Calc.GetColumnName" +Const cstSubArgs = "ColumnNumber" + + If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch + sCol = "" + +Check: + If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then + If Not SF_Utils._Validate(ColumnNumber, "ColumnNumber", V_NUMERIC) Then GoTo Finally + End If + +Try: + If (ColumnNumber > 0) And (ColumnNumber <= MAXCOLS) Then sCol = _GetColumnName(ColumnNumber) + +Finally: + GetColumnName = sCol + ScriptForge.SF_Utils._ExitFunction(cstThisSub) + Exit Function +Catch: + GoTo Finally +End Function ' SFDocuments.SF_Calc.GetColumnName + +REM ----------------------------------------------------------------------------- +Public Function GetFormula(Optional ByVal Range As Variant) As Variant +''' Get the formula(e) stored in the given range of cells +''' Args: +''' Range : the range as a string where to get the formula from +''' Returns: +''' A scalar, a zero-based 1D array or a zero-based 2D array of strings +''' Examples: +''' Val = oDoc.GetFormula("~.A1:A1000") + +Dim vGet As Variant ' Return value +Dim oAddress As Object ' Alias of Range +Dim vDataArray As Variant ' DataArray compatible with .DataArray UNO property +Const cstThisSub = "SFDocuments.Calc.GetFormula" +Const cstSubArgs = "Range" + + If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch + vGet = Empty + +Check: + If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then + If Not _IsStillAlive() Then GoTo Finally + If Not ScriptForge.SF_Utils._Validate(Range, "Range", V_STRING) Then GoTo Finally + End If + +Try: + ' Get the data + Set oAddress = _ParseAddress(Range) + vDataArray = oAddress.XCellRange.getFormulaArray() + + ' Convert the data array to scalar, vector or array + vGet = _ConvertFromDataArray(vDataArray) + +Finally: + GetFormula = vGet + ScriptForge.SF_Utils._ExitFunction(cstThisSub) + Exit Function +Catch: + GoTo Finally +End Function ' 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 = _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" _ + , "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 = _ConvertToDataArray(Value) + If UBound(vDataArray) < LBound(vDataArray) Then GoTo Finally + Set oSet = _Offset(TargetCell, 0, 0, plHeight := UBound(vDataArray) + 1, plWidth := UBound(vDataArray(0)) + 1) ' +1 : vDataArray is zero-based + With oSet + .XCellRange.setDataArray(vDataArray) + sSet = .RangeName + End With + +Finally: + SetArray = sSet + ScriptForge.SF_Utils._ExitFunction(cstThisSub) + Exit Function +Catch: + GoTo Finally +End Function ' 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) 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 = _ConvertToDataArray(Formula, .Height - 1, .Width - 1) + If UBound(vDataArray) < LBound(vDataArray) Then GoTo Finally + .XCellRange.setFormulaArray(vDataArray) + Else + With .XCellRange + ' Store formula in top-left cell and paste it along the whole range + .getCellByPosition(0, 0).setFormula(Formula) + .fillSeries(com.sun.star.sheet.FillDirection.TO_BOTTOM, com.sun.star.sheet.FillMode.SIMPLE, 0, 0, 0) + .fillSeries(com.sun.star.sheet.FillDirection.TO_RIGHT, com.sun.star.sheet.FillMode.SIMPLE, 0, 0, 0) + End With + End If + sSet = .RangeName + End With + +Finally: + SetFormula = sSet + ScriptForge.SF_Utils._ExitFunction(cstThisSub) + Exit Function +Catch: + GoTo Finally +End Function ' 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 o.XSpreadsheet.Name)f the range. +''' The new values should be strings, numeric values or dates. Other types empty the corresponding cell +''' Returns: +''' A string representing the updated range +''' Examples: +''' oDoc.SetValue("A1", 2) +''' oDoc.SetValue("A1:F1", Array(1, 2, 3)) ' Horizontal vector, partially empty +''' oDoc.SetValue("A1:D2", SF_Array.AppendRow(Array(1, 2, 3, 4), Array(5, 6, 7, 8))) + +Dim sSet As String ' Return value +Dim oAddress As Object ' Alias of TargetRange +Dim vDataArray As Variant ' DataArray compatible with .DataArray UNO property +Const cstThisSub = "SFDocuments.Calc.SetValue" +Const cstSubArgs = "TargetRange, Value" + + If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch + sSet = "" + +Check: + If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then + If Not _IsStillAlive() Then GoTo Finally + If Not ScriptForge.SF_Utils._Validate(TargetRange, "TargetRange", V_STRING) Then GoTo Finally + If IsArray(Value) Then + If Not ScriptForge.SF_Utils._ValidateArray(Value, "Value") Then GoTo Finally + Else + If Not ScriptForge.SF_Utils._Validate(Value, "Value") Then GoTo Finally + End If + End If + +Try: + Set oAddress = _ParseAddress(TargetRange) + With oAddress + ' Convert to data array and limit its size to the size of the initial range + vDataArray = _ConvertToDataArray(Value, .Height - 1, .Width - 1) + If UBound(vDataArray) < LBound(vDataArray) Then GoTo Finally + .XCellRange.setDataArray(vDataArray) + sSet = .RangeName + End With + +Finally: + SetValue = sSet + ScriptForge.SF_Utils._ExitFunction(cstThisSub) + Exit Function +Catch: + GoTo Finally +End Function ' 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 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 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 = _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 ----------------------------------------------------------------------------- +Public Function _ConvertFromDataArray(ByRef pvDataArray As Variant) As Variant +''' Convert a data array to a scalar, a vector or a 2D array +''' Args: +''' pvDataArray: an array as returned by the XCellRange.getDataArray or .getFormulaArray methods +''' Returns: +''' A scalar, a zero-based 1D array or a zero-based 2D array of strings and/or doubles +''' To convert doubles to dates, use the CDate builtin function + +Dim vArray As Variant ' Return value +Dim lMax1 As Long ' UBound of pvDataArray +Dim lMax2 As Long ' UBound of pvDataArray items +Dim i As Long +Dim j As Long + + vArray = Empty + +Try: + ' Convert the data array to scalar, vector or array + lMax1 = UBound(pvDataArray) + If lMax1 >= 0 Then + lMax2 = UBound(pvDataArray(0)) + If lMax2 >= 0 Then + If lMax1 + lMax2 > 0 Then vArray = Array() + Select Case True + Case lMax1 = 0 And lMax2 = 0 ' Scalar + vArray = pvDataArray(0)(0) + Case lMax1 > 0 And lMax2 = 0 ' Vertical vector + ReDim vArray(0 To lMax1) + For i = 0 To lMax1 + vArray(i) = pvDataArray(i)(0) + Next i + Case lMax1 = 0 And lMax2 > 0 ' Horizontal vector + ReDim vArray(0 To lMax2) + For j = 0 To lMax2 + vArray(j) = pvDataArray(0)(j) + Next j + Case Else ' Array + ReDim vArray(0 To lMax1, 0 To lMax2) + For i = 0 To lMax1 + For j = 0 To lMax2 + vArray(i, j) = pvDataArray(i)(j) + Next j + Next i + End Select + End If + End If + +Finally: + _ConvertFromDataArray = vArray +End Function ' SFDocuments.SF_Calc._ConvertFromDataArray + +REM ----------------------------------------------------------------------------- +Private Function _ConvertToCellValue(ByVal pvItem As Variant) As Variant +''' Convert the argument to a valid Calc cell content + +Dim vCell As Variant ' Return value + +Try: + Select Case ScriptForge.SF_Utils._VarTypeExt(pvItem) + Case V_STRING : vCell = pvItem + Case V_DATE : vCell = CDbl(pvItem) + Case ScriptForge.V_NUMERIC : vCell = CDbl(pvItem) + Case ScriptForge.V_BOOLEAN : vCell = CDbl(Iif(pvItem, 1, 0)) + Case Else : vCell = "" + End Select + +Finally: + _ConvertToCellValue = vCell + Exit Function +End Function ' SFDocuments.SF_Calc._ConvertToCellValue + +REM ----------------------------------------------------------------------------- +Private Function _ConvertToDataArray(ByRef pvArray As Variant _ + , Optional ByVal plRows As Long _ + , Optional ByVal plColumns As Long _ + ) As Variant +''' Create a 2-dimensions nested array (compatible with the ranges .DataArray property) +''' from a scalar, a 1D array or a 2D array +''' Input may be a 1D array of arrays, typically when call issued by a Python script +''' Array items are converted to (possibly empty) strings or doubles +''' Args: +''' pvArray: the input scalar or array. If array, must be 1 or 2D otherwise it is ignored. +''' plRows, plColumns: the upper bounds of the data array +''' If bigger than input array, fill with zero-length strings +''' If smaller than input array, truncate +''' If plRows = 0 and the input array is a vector, the data array is aligned horizontally +''' They are either both present or both absent +''' When absent +''' The size of the output is fully determined by the input array +''' Vectors are aligned vertically +''' Returns: +''' A data array compatible with ranges .DataArray property +''' The output is always an array of nested arrays + +Dim vDataArray() As Variant ' Return value +Dim vVector() As Variant ' A temporary 1D array +Dim vItem As Variant ' A single input item +Dim iDims As Integer ' Number of dimensions of the input argument +Dim lMin1 As Long ' Lower bound (1) of input array +Dim lMax1 As Long ' Upper bound (1) +Dim lMin2 As Long ' Lower bound (2) +Dim lMax2 As Long ' Upper bound (2) +Dim lRows As Long ' Upper bound of vDataArray +Dim lCols As Long ' Upper bound of vVector +Dim bHorizontal As Boolean ' Horizontal vector +Dim bDataArray As Boolean ' Input array is already an array of arrays +Dim i As Long +Dim j As Long + +Const cstEmpty = "" ' Empty cell + + If IsMissing(plRows) Or IsEmpty(plRows) Then plRows = -1 + If IsMissing(plColumns) Or IsEmpty(plColumns) Then plColumns = -1 + + vDataArray = Array() + +Try: + ' Check the input argument and know its boundaries + iDims = ScriptForge.SF_Array.CountDims(pvArray) + If iDims = 0 Or iDims > 2 Then Exit Function + lMin1 = 0 : lMax1 = 0 ' Default values + lMin2 = 0 : lMax2 = 0 + Select Case iDims + Case -1 ' Scalar value + Case 1 + bHorizontal = ( plRows = 0 And plColumns > 0 ) + bDataArray = IsArray(pvArray(0)) + If Not bDataArray Then + If Not bHorizontal Then + lMin1 = LBound(pvArray) : lMax1 = UBound(pvArray) + Else + lMin2 = LBound(pvArray) : lMax2 = UBound(pvArray) + End If + Else + iDims = 2 + lMin1 = LBound(pvArray) : lMax1 = UBound(pvArray) + lMin2 = LBound(pvArray(0)) : lMax2 = UBound(pvArray(0)) + End If + Case 2 + lMin1 = LBound(pvArray, 1) : lMax1 = UBound(pvArray, 1) + lMin2 = LBound(pvArray, 2) : lMax2 = UBound(pvArray, 2) + End Select + + ' Set the output dimensions accordingly + If plRows >= 0 Then ' Dimensions of output are imposed + lRows = plRows + lCols = plColumns + Else ' Dimensions of output determined by input argument + lRows = 0 : lCols = 0 ' Default values + Select Case iDims + Case -1 ' Scalar value + Case 1 ' Vectors are aligned vertically + lRows = lMax1 - lMin1 + Case 2 + lRows = lMax1 - lMin1 + lCols = lMax2 - lMin2 + End Select + End If + ReDim vDataArray(0 To lRows) + + ' Feed the output array row by row, each row being a vector + For i = 0 To lRows + ReDim vVector(0 To lCols) + For j = 0 To lCols + If i > lMax1 - lMin1 Then + vVector(j) = cstEmpty + ElseIf j > lMax2 - lMin2 Then + vVector(j) = cstEmpty + Else + Select Case iDims + Case -1 : vItem = _ConvertToCellValue(pvArray) + Case 1 + If bHorizontal Then + vItem = _ConvertToCellValue(pvArray(j + lMin2)) + Else + vItem = _ConvertToCellValue(pvArray(i + lMin1)) + End If + Case 2 + If bDataArray Then + vItem = _ConvertToCellValue(pvArray(i + lMin1)(j + lMin2)) + Else + vItem = _ConvertToCellValue(pvArray(i + lMin1, j + lMin2)) + End If + End Select + vVector(j) = vItem + End If + vDataArray(i) = vVector + Next j + Next i + +Finally: + _ConvertToDataArray = vDataArray + Exit Function +End Function ' SFDocuments.SF_Calc._ConvertToDataArray + +REM ----------------------------------------------------------------------------- +Private Function _DFunction(ByVal psFunction As String _ + , Optional ByVal Range As Variant _ + ) As Double +''' Apply the given function on all the numeric values stored in the given range +''' Args: +''' Range : the range as a string where to apply the function on +''' Returns: +''' The resulting value as a double + +Dim dblGet As Double ' Return value +Dim oAddress As Object ' Alias of Range +Dim vFunction As Variant ' com.sun.star.sheet.GeneralFunction.XXX +Dim cstThisSub As String : cstThisSub = "SFDocuments.Calc." & psFunction +Const cstSubArgs = "Range" + + If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch + dblGet = 0 + +Check: + If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then + If Not _IsStillAlive() Then GoTo Finally + If Not ScriptForge.SF_Utils._Validate(Range, "Range", V_STRING) Then GoTo Finally + End If + +Try: + ' Get the data + Set oAddress = _ParseAddress(Range) + Select Case psFunction + Case "DAvg" : vFunction = com.sun.star.sheet.GeneralFunction.AVERAGE + Case "DCount" : vFunction = com.sun.star.sheet.GeneralFunction.COUNTNUMS + Case "DMax" : vFunction = com.sun.star.sheet.GeneralFunction.MAX + Case "DMin" : vFunction = com.sun.star.sheet.GeneralFunction.MIN + Case "DSum" : vFunction = com.sun.star.sheet.GeneralFunction.SUM + Case Else : GoTo Finally + End Select + dblGet = oAddress.XCellRange.computeFunction(vFunction) + +Finally: + _DFunction = dblGet + ScriptForge.SF_Utils._ExitFunction(cstThisSub) + Exit Function +Catch: + GoTo Finally +End Function ' 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>
\ No newline at end of file |