Linux ns1.utparral.edu.mx 6.8.0-79-generic #79~22.04.1-Ubuntu SMP PREEMPT_DYNAMIC Fri Aug 15 16:54:53 UTC 2 x86_64
Apache/2.4.58 (Unix) OpenSSL/1.1.1w PHP/8.2.12 mod_perl/2.0.12 Perl/v5.34.1
: 10.10.1.9 | : 10.10.1.254
Cant Read [ /etc/named.conf ]
daemon
Terminal
AUTO ROOT
Adminer
Backdoor Destroyer
Linux Exploit
Lock Shell
Lock File
Create User
README
+ Create Folder
+ Create File
/
usr /
lib /
libreoffice /
share /
basic /
SFDocuments /
[ HOME SHELL ]
Name
Size
Permission
Action
dialog.xlb
290
B
-rw-r--r--
__License.xba
1.77
KB
-rw-r--r--
script.xlb
770
B
-rw-r--r--
SF_Base.xba
43.71
KB
-rw-r--r--
SF_Calc.xba
174.42
KB
-rw-r--r--
SF_Chart.xba
36.89
KB
-rw-r--r--
SF_DocumentListener.xba
5.58
KB
-rw-r--r--
SF_Document.xba
55.97
KB
-rw-r--r--
SF_FormControl.xba
92.72
KB
-rw-r--r--
SF_Form.xba
67.91
KB
-rw-r--r--
SF_Register.xba
24.31
KB
-rw-r--r--
SF_Writer.xba
27.21
KB
-rw-r--r--
Delete
Unzip
Zip
${this.title}
Close
Code Editor : SF_Calc.xba
<?xml version="1.0" encoding="UTF-8"?> <!DOCTYPE script:module PUBLIC "-//OpenOffice.org//DTD OfficeDocument 1.0//EN" "module.dtd"> <script:module xmlns:script="http://openoffice.org/2000/script" script:name="SF_Calc" script:language="StarBasic" script:moduleType="normal">REM ======================================================================================================================= REM === The ScriptForge library and its associated libraries are part of the LibreOffice project. === REM === The SFDocuments library is one of the associated libraries. === REM === Full documentation is available on https://help.libreoffice.org/ === REM ======================================================================================================================= Option Compatible Option ClassModule Option Explicit ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' ''' SF_Calc ''' ======= ''' ''' The SFDocuments library gathers a number of methods and properties making easy ''' managing and manipulating LibreOffice documents ''' ''' Some methods are generic for all types of documents: they are combined in the SF_Document module. ''' Specific properties and methods are implemented in the concerned subclass(es) SF_Calc, SF_Base, ... ''' ''' To workaround the absence of class inheritance in LibreOffice Basic, some redundancy is necessary ''' Each subclass MUST implement also the generic methods and properties, even if they only call ''' the parent methods and properties. ''' They should also duplicate some generic private members as a subset of their own set of members ''' ''' The SF_Calc module is focused on : ''' - management (copy, insert, move, ...) of sheets within a Calc document ''' - exchange of data between Basic data structures and Calc ranges of values ''' ''' The current module is closely related to the "UI" service of the ScriptForge library ''' ''' Service invocation examples: ''' 1) From the UI service ''' Dim ui As Object, oDoc As Object ''' Set ui = CreateScriptService("UI") ''' Set oDoc = ui.CreateDocument("Calc", ...) ''' ' or Set oDoc = ui.OpenDocument("C:\Me\MyFile.ods") ''' 2) Directly if the document is already opened ''' Dim oDoc As Object ''' Set oDoc = CreateScriptService("SFDocuments.Calc", "Untitled 1") ' Default = ActiveWindow ''' ' or Set oDoc = CreateScriptService("SFDocuments.Calc", "Untitled 1") ' Untitled 1 is presumed a Calc document ''' ' The substring "SFDocuments." in the service name is optional ''' ''' Definitions: ''' Many methods require a "Sheet" or a "Range" as argument. (NB: a single cell is considered as a special case of a Range) ''' Usually, within a specific Calc instance, sheets and ranges are given as a string: "SheetX" and "D2:F6" ''' Multiple ranges are not supported in this context. ''' Additionally, the .Sheet and .Range methods return a reference that may be used ''' as argument of a method called from another instance of the Calc service ''' Example: ''' Dim oDocA As Object : Set oDocA = ui.OpenDocument("C:\FileA.ods", Hidden := True, ReadOnly := True) ''' Dim oDocB As Object : Set oDocB = ui.OpenDocument("C:\FileB.ods") ''' oDocB.CopyToRange(oDocA.Range("SheetX.D4:F8"), "D2:F6") ' CopyToRange(source, target) ''' ''' Sheet: the sheet name as a string or an object produced by .Sheet() ''' "~" = current sheet ''' Range: a string designating a set of contiguous cells located in a sheet of the current instance ''' "~" = current selection (if multiple selections, its 1st component) ''' or an object produced by .Range() ''' The sheet name is optional (default = active sheet). Surrounding quotes and $ signs are optional ''' ~.~, ~ The current selection in the active sheet ''' '$SheetX'.D2 or $D$2 A single cell ''' '$SheetX'.D2:F6, D2:D10 Multiple cells ''' '$SheetX'.A:A or 3:5 All cells in the same column or row up to the last active cell ''' SheetX.* All cells up to the last active cell ''' myRange A range name at spreadsheet level ''' ~.yourRange, SheetX.someRange A range name at sheet level ''' myDoc.Range("SheetX.D2:F6") ''' A range within the sheet SheetX in file associated with the myDoc Calc instance ''' ''' Detailed user documentation: ''' https://help.libreoffice.org/latest/en-US/text/sbasic/shared/03/sf_calc.html?DbPAR=BASIC ''' ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' REM ================================================================== EXCEPTIONS Private Const UNKNOWNFILEERROR = "UNKNOWNFILEERROR" Private Const BASEDOCUMENTOPENERROR = "BASEDOCUMENTOPENERROR" Private Const CALCADDRESSERROR = "CALCADDRESSERROR" Private Const DUPLICATESHEETERROR = "DUPLICATESHEETERROR" Private Const OFFSETADDRESSERROR = "OFFSETADDRESSERROR" Private Const CALCFORMNOTFOUNDERROR = "CALCFORMNOTFOUNDERROR" Private Const DUPLICATECHARTERROR = "DUPLICATECHARTERROR" REM ============================================================= PRIVATE MEMBERS Private [Me] As Object Private [_Parent] As Object Private [_Super] As Object ' Document superclass, which the current instance is a subclass of Private ObjectType As String ' Must be CALC Private ServiceName As String ' Window component Private _Component As Object ' com.sun.star.lang.XComponent Type _Address ObjectType As String ' Must be "SF_CalcReference" ServiceName As String ' Must be "SFDocuments.CalcReference" RawAddress As String Component As Object ' com.sun.star.lang.XComponent SheetName As String SheetIndex As Integer RangeName As String Height As Long Width As Long XSpreadSheet As Object ' com.sun.star.sheet.XSpreadsheet XCellRange As Object ' com.sun.star.table.XCellRange End Type 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^10 ' Max number of columns in a sheet Private Const MAXROWS = 2^20 ' Max number of rows in a sheet Private Const CALCREFERENCE = "SF_CalcReference" ' Object type of _Address Private Const SERVICEREFERENCE = "SFDocuments.CalcReference" ' Service name of _Address (used in Python) Private Const ISCALCFORM = 2 ' Form is stored in a Calc document 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 [_Parent] = 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 ' SF_Documents.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) As String ''' Clear entirely the given range ''' Args: ''' Range : the cell or the range as a string that should be cleared ''' Examples: ''' oDoc.ClearAll("SheetX") ' Clears the used area of the sheet Dim lClear As Long ' The elements to clear Dim oRange As Object ' Alias of Range Const cstThisSub = "SFDocuments.Calc.ClearAll" Const cstSubArgs = "Range" If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch Check: If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then If Not _IsStillAlive() Then GoTo Finally If Not ScriptForge.SF_Utils._Validate(Range, "Range", V_STRING) Then GoTo Finally End If Try: With com.sun.star.sheet.CellFlags lClear = 0 _ + .VALUE _ + .DATETIME _ + .STRING _ + .ANNOTATION _ + .FORMULA _ + .HARDATTR _ + .STYLES _ + .OBJECTS _ + .EDITATTR _ + .FORMATTED Set oRange = _ParseAddress(Range) oRange.XCellRange.clearContents(lClear) End With Finally: ScriptForge.SF_Utils._ExitFunction(cstThisSub) Exit Sub Catch: GoTo Finally End Sub ' SF_Documents.SF_Calc.ClearAll REM ----------------------------------------------------------------------------- Public Sub ClearFormats(Optional ByVal Range As Variant) As String ''' Clear all the formatting elements of the given range ''' Args: ''' Range : the cell or the range as a string that should be cleared ''' Examples: ''' oDoc.ClearFormats("SheetX:A1:E100") ' Clear the formats of the given range Dim lClear As Long ' The elements to clear Dim oRange As Object ' Alias of Range Const cstThisSub = "SFDocuments.Calc.ClearFormats" Const cstSubArgs = "Range" If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch Check: If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then If Not _IsStillAlive() Then GoTo Finally If Not ScriptForge.SF_Utils._Validate(Range, "Range", V_STRING) Then GoTo Finally End If Try: With com.sun.star.sheet.CellFlags lClear = 0 _ + .HARDATTR _ + .STYLES _ + .EDITATTR _ + .FORMATTED Set oRange = _ParseAddress(Range) oRange.XCellRange.clearContents(lClear) End With Finally: ScriptForge.SF_Utils._ExitFunction(cstThisSub) Exit Sub Catch: GoTo Finally End Sub ' SF_Documents.SF_Calc.ClearFormats REM ----------------------------------------------------------------------------- Public Sub ClearValues(Optional ByVal Range As Variant) As String ''' Clear values and formulas in the given range ''' Args: ''' Range : the cell or the range as a string that should be cleared ''' Examples: ''' oDoc.ClearValues("SheetX:*") ' Clears the used area of the sheet Dim lClear As Long ' The elements to clear Dim oRange As Object ' Alias of Range Const cstThisSub = "SFDocuments.Calc.ClearValues" Const cstSubArgs = "Range" If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch Check: If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then If Not _IsStillAlive() Then GoTo Finally If Not ScriptForge.SF_Utils._Validate(Range, "Range", V_STRING) Then GoTo Finally End If Try: With com.sun.star.sheet.CellFlags lClear = 0 _ + .VALUE _ + .DATETIME _ + .STRING _ + .FORMULA Set oRange = _ParseAddress(Range) oRange.XCellRange.clearContents(lClear) End With Finally: ScriptForge.SF_Utils._ExitFunction(cstThisSub) Exit Sub Catch: GoTo Finally End Sub ' SF_Documents.SF_Calc.ClearValues REM ----------------------------------------------------------------------------- Public Function CopySheet(Optional ByVal SheetName As Variant _ , Optional ByVal NewName As Variant _ , Optional ByVal BeforeSheet As Variant _ ) As Boolean ''' Copy a specified sheet before an existing sheet or at the end of the list of sheets ''' The sheet to copy may be inside any open Calc document ''' Args: ''' SheetName: The name of the sheet to copy or its reference ''' NewName: Must not exist ''' BeforeSheet: The name (string) or index (numeric, starting from 1) of the sheet before which to insert ''' Returns: ''' True if the sheet could be copied successfully ''' Exceptions: ''' DUPLICATESHEETERROR A sheet with the given name exists already ''' Examples: ''' oDoc.CopySheet("SheetX", "SheetY") ''' ' Copy within the same document ''' Dim oDocA As Object : Set oDocA = ui.OpenDocument("C:\Temp\FileA.ods", Hidden := True, ReadOnly := True) ''' Dim oDocB As Object : Set oDocB = ui.OpenDocument("C:\Temp\FileB.ods") ''' oDocB.CopySheet(oDocA.Sheet("SheetX"), "SheetY") ''' ' Copy from 1 file to another and put the new sheet at the end Dim bCopy As Boolean ' Return value Dim oSheets As Object ' com.sun.star.sheet.XSpreadsheets Dim vSheets As Variant ' List of existing sheets Dim lSheetIndex As Long ' Index of a sheet Dim oSheet As Object ' Alias of SheetName as reference Dim lRandom As Long ' Output of random number generator Dim sRandom ' Random sheet name Const cstThisSub = "SFDocuments.Calc.CopySheet" Const cstSubArgs = "SheetName, NewName, [BeforeSheet=""""]" If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch bCopy = False Check: If IsMissing(BeforeSheet) Or IsEmpty(BeforeSheet) Then BeforeSheet = 32768 If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then If Not _IsStillAlive(True) Then GoTo Finally If Not _ValidateSheet(SheetName, "SheetName", , True, , , True) Then GoTo Finally If Not _ValidateSheet(NewName, "NewName", True) Then GoTo Finally If Not _ValidateSheet(BeforeSheet, "BeforeSheet", , True, , True) Then GoTo Finally End If Try: ' Determine the index of the sheet before which to insert the copy Set oSheets = _Component.getSheets vSheets = oSheets.getElementNames() If VarType(BeforeSheet) = V_STRING Then lSheetIndex = ScriptForge.SF_Array.IndexOf(vSheets, BeforeSheet) Else lSheetIndex = BeforeSheet - 1 If lSheetIndex < 0 Then lSheetIndex = 0 If lSheetIndex > UBound(vSheets) Then lSheetIndex = UBound(vSheets) + 1 End If ' Copy sheet inside the same document OR import from another document If VarType(SheetName) = V_STRING Then _Component.getSheets.copyByName(SheetName, NewName, lSheetIndex) Else Set oSheet = SheetName With oSheet ' If a sheet with same name as input exists in the target sheet, rename it first with a random name sRandom = "" If ScriptForge.SF_Array.Contains(vSheets, .SheetName) Then lRandom = ScriptForge.SF_Session.ExecuteCalcFunction("RANDBETWEEN", 1, 9999999) sRandom = "SF_" & Right("0000000" & lRandom, 7) oSheets.getByName(.SheetName).setName(sRandom) End If ' Import i.o. Copy oSheets.importSheet(oSheet.Component, .SheetName, lSheetIndex) ' Rename to new sheet name oSheets.getByName(.SheetName).setName(NewName) ' Reset random name If Len(sRandom) > 0 Then oSheets.getByName(srandom).setName(.SheetName) End With End If bCopy = True Finally: CopySheet = bCopy ScriptForge.SF_Utils._ExitFunction(cstThisSub) Exit Function Catch: GoTo Finally CatchDuplicate: ScriptForge.SF_Exception.RaiseFatal(DUPLICATESHEETERROR, "NewName", NewName, "Document", [_Super]._FileIdent()) GoTo Finally End Function ' SFDocuments.SF_Calc.CopySheet REM ----------------------------------------------------------------------------- Public Function CopySheetFromFile(Optional ByVal FileName As Variant _ , Optional ByVal SheetName As Variant _ , Optional ByVal NewName As Variant _ , Optional ByVal BeforeSheet As Variant _ ) As Boolean ''' Copy a specified sheet before an existing sheet or at the end of the list of sheets ''' The sheet to copy is located inside any closed Calc document ''' Args: ''' FileName: Identifies the file to open. It must follow the SF_FileSystem.FileNaming notation ''' The file must not be protected with a password ''' SheetName: The name of the sheet to copy ''' NewName: Must not exist ''' BeforeSheet: The name (string) or index (numeric, starting from 1) of the sheet before which to insert ''' Returns: ''' True if the sheet could be created ''' The created sheet is blank when the input file is not a Calc file ''' The created sheet contains an error message when the input sheet was not found ''' Exceptions: ''' DUPLICATESHEETERROR A sheet with the given name exists already ''' UNKNOWNFILEERROR The input file is unknown ''' Examples: ''' oDoc.CopySheetFromFile("C:\MyFile.ods", "SheetX", "SheetY", 3) Dim bCopy As Boolean ' Return value Dim oSheet As Object ' com.sun.star.sheet.XSpreadsheet Dim sFileName As String ' URL alias of FileName Dim FSO As Object ' SF_FileSystem Const cstThisSub = "SFDocuments.Calc.CopySheetFromFile" Const cstSubArgs = "FileName, SheetName, NewName, [BeforeSheet=""""]" If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch bCopy = False Check: If IsMissing(BeforeSheet) Or IsEmpty(BeforeSheet) Then BeforeSheet = 32768 If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then If Not _IsStillAlive(True) Then GoTo Finally If Not ScriptForge.SF_Utils._ValidateFile(FileName, "FileName") Then GoTo Finally If Not ScriptForge.SF_Utils._Validate(SheetName, "SheetName", V_STRING) Then GoTo Finally If Not _ValidateSheet(NewName, "NewName", True) Then GoTo Finally If Not _ValidateSheet(BeforeSheet, "BeforeSheet", , True, , True) Then GoTo Finally End If Try: Set FSO = ScriptForge.SF_FileSystem ' Does the input file exist ? If Not FSO.FileExists(FileName) Then GoTo CatchNotExists sFileName = FSO._ConvertToUrl(FileName) ' Insert a blank new sheet and import sheet from file 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 DAvg(Optional ByVal Range As Variant) As Double ''' Get the average of the numeric values stored in the given range ''' Args: ''' Range : the range as a string where to get the values from ''' Returns: ''' The average of the numeric values as a double ''' Examples: ''' Val = oDoc.DAvg("~.A1:A1000") Try: DAvg = _DFunction("DAvg", Range) Finally: Exit Function End Function ' SF_Documents.SF_Calc.DAvg REM ----------------------------------------------------------------------------- Public Function DCount(Optional ByVal Range As Variant) As Long ''' Get the number of numeric values stored in the given range ''' Args: ''' Range : the range as a string where to get the values from ''' Returns: ''' The number of numeric values as a Long ''' Examples: ''' Val = oDoc.DCount("~.A1:A1000") Try: DCount = _DFunction("DCount", Range) Finally: Exit Function End Function ' SF_Documents.SF_Calc.DCount REM ----------------------------------------------------------------------------- Public Function DMax(Optional ByVal Range As Variant) As Double ''' Get the greatest of the numeric values stored in the given range ''' Args: ''' Range : the range as a string where to get the values from ''' Returns: ''' The greatest of the numeric values as a double ''' Examples: ''' Val = oDoc.DMax("~.A1:A1000") Try: DMax = _DFunction("DMax", Range) Finally: Exit Function End Function ' SF_Documents.SF_Calc.DMax REM ----------------------------------------------------------------------------- Public Function DMin(Optional ByVal Range As Variant) As Double ''' Get the smallest of the numeric values stored in the given range ''' Args: ''' Range : the range as a string where to get the values from ''' Returns: ''' The smallest of the numeric values as a double ''' Examples: ''' Val = oDoc.DMin("~.A1:A1000") Try: DMin = _DFunction("DMin", Range) Finally: Exit Function End Function ' SF_Documents.SF_Calc.DMin REM ----------------------------------------------------------------------------- Public Function DSum(Optional ByVal Range As Variant) As Double ''' Get sum of the numeric values stored in the given range ''' Args: ''' Range : the range as a string where to get the values from ''' Returns: ''' The sum of the numeric values as a double ''' Examples: ''' Val = oDoc.DSum("~.A1:A1000") Try: DSum = _DFunction("DSum", Range) Finally: Exit Function End Function ' SF_Documents.SF_Calc.DSum REM ----------------------------------------------------------------------------- Public Function Forms(Optional ByVal SheetName As Variant _ , Optional ByVal Form As Variant _ ) As Variant ''' Return either ''' - the list of the Forms contained in the given sheet ''' - a SFDocuments.Form object based on its name or its index ''' Args: ''' SheetName: the name of the sheet containing the requested form or forms ''' Form: a form stored in the document given by its name or its index ''' When absent, the list of available forms is returned ''' To get the first (unique ?) form stored in the form document, set Form = 0 ''' Exceptions: ''' CALCFORMNOTFOUNDERROR Form not found ''' Returns: ''' A zero-based array of strings if Form is absent ''' An instance of the SF_Form class if Form exists ''' Example: ''' Dim myForm As Object, myList As Variant ''' myList = oDoc.Forms("ThisSheet") ''' Set myForm = oDoc.Forms("ThisSheet", 0) Dim oForm As Object ' The new Form class instance Dim oMainForm As Object ' com.sun.star.comp.sdb.Content Dim oXForm As Object ' com.sun.star.form.XForm or com.sun.star.comp.forms.ODatabaseForm Dim vFormNames As Variant ' Array of form names Dim oForms As Object ' Forms collection Const cstDrawPage = -1 ' There is no DrawPages collection in Calc sheets Const cstThisSub = "SFDocuments.Calc.Forms" Const cstSubArgs = "SheetName, [Form=""""]" If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch Check: If IsMissing(Form) Or IsEmpty(Form) Then Form = "" If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then If Not _IsStillAlive() Then GoTo Finally If Not _ValidateSheet(SheetName, "SheetName", , True) Then GoTo Finally If Not ScriptForge.SF_Utils._Validate(Form, "Form", Array(V_STRING, ScriptForge.V_NUMERIC)) Then GoTo Finally End If Try: ' Start from the Calc sheet and go down to forms Set oForms = _Component.getSheets.getByName(SheetName).DrawPage.Forms vFormNames = oForms.getElementNames() If Len(Form) = 0 Then ' Return the list of valid form names Forms = vFormNames Else If VarType(Form) = V_STRING Then ' Find the form by name If Not ScriptForge.SF_Utils._Validate(Form, "Form", V_STRING, vFormNames) Then GoTo Finally Set oXForm = oForms.getByName(Form) Else ' Find the form by index If Form < 0 Or Form >= oForms.Count Then GoTo CatchNotFound Set oXForm = oForms.getByIndex(Form) End If ' Create the new Form class instance Set oForm = SF_Register._NewForm(oXForm) With oForm Set .[_Parent] = [Me] ._SheetName = SheetName ._FormType = ISCALCFORM Set ._Component = _Component ._Initialize() End With Set Forms = oForm End If Finally: ScriptForge.SF_Utils._ExitFunction(cstThisSub) Exit Function Catch: GoTo Finally CatchNotFound: ScriptForge.SF_Exception.RaiseFatal(CALCFORMNOTFOUNDERROR, Form, _FileIdent()) End Function ' SFDocuments.SF_Calc.Forms REM ----------------------------------------------------------------------------- Function GetColumnName(Optional ByVal ColumnNumber As Variant) As String ''' Convert a column number (range 1, 2,..1024) into its letter counterpart (range 'A', 'B',..'AMJ'). ''' Args: ''' ColumnNumber: the column number, must be in the interval 1 ... 1024 ''' Returns: ''' a string representation of the column name, in range 'A'..'AMJ' ''' If ColumnNumber is not in the allowed range, returns a zero-length string ''' Example: ''' MsgBox oDoc.GetColumnName(1022) ' "AMH" ''' Adapted from a Python function by sundar nataraj ''' http://stackoverflow.com/questions/23861680/convert-spreadsheet-number-to-column-letter Dim sCol As String ' Return value Const cstThisSub = "SFDocuments.Calc.GetColumnName" Const cstSubArgs = "ColumnNumber" If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch sCol = "" Check: If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then If Not SF_Utils._Validate(ColumnNumber, "ColumnNumber", V_NUMERIC) Then GoTo Finally End If Try: If (ColumnNumber > 0) And (ColumnNumber <= MAXCOLS) Then sCol = _GetColumnName(ColumnNumber) Finally: GetColumnName = sCol ScriptForge.SF_Utils._ExitFunction(cstThisSub) Exit Function Catch: GoTo Finally End Function ' SFDocuments.SF_Calc.GetColumnName REM ----------------------------------------------------------------------------- Public Function GetFormula(Optional ByVal Range As Variant) As Variant ''' Get the formula(e) stored in the given range of cells ''' Args: ''' Range : the range as a string where to get the formula from ''' Returns: ''' A scalar, a zero-based 1D array or a zero-based 2D array of strings ''' Examples: ''' Val = oDoc.GetFormula("~.A1:A1000") Dim vGet As Variant ' Return value Dim oAddress As Object ' Alias of Range Dim vDataArray As Variant ' DataArray compatible with .DataArray UNO property Const cstThisSub = "SFDocuments.Calc.GetFormula" Const cstSubArgs = "Range" If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch vGet = Empty Check: If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then If Not _IsStillAlive() Then GoTo Finally If Not ScriptForge.SF_Utils._Validate(Range, "Range", V_STRING) Then GoTo Finally End If Try: ' Get the data Set oAddress = _ParseAddress(Range) vDataArray = oAddress.XCellRange.getFormulaArray() ' Convert the data array to scalar, vector or array vGet = _ConvertFromDataArray(vDataArray) Finally: GetFormula = vGet ScriptForge.SF_Utils._ExitFunction(cstThisSub) Exit Function Catch: GoTo Finally End Function ' SF_Documents.SF_Calc.GetFormula REM ----------------------------------------------------------------------------- Public Function GetProperty(Optional ByVal PropertyName As Variant _ , Optional ObjectName As Variant _ ) As Variant ''' Return the actual value of the given property ''' Args: ''' PropertyName: the name of the property as a string ''' ObjectName: a sheet or range name ''' Returns: ''' The actual value of the property ''' Exceptions: ''' ARGUMENTERROR The property does not exist Const cstThisSub = "SFDocuments.Calc.GetProperty" Const cstSubArgs = "" If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch GetProperty = Null Check: If IsMissing(ObjectName) Or IsEMpty(ObjectName) Then ObjectName = "" If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then If Not ScriptForge.SF_Utils._Validate(PropertyName, "PropertyName", V_STRING, Properties()) Then GoTo Catch If Not ScriptForge.SF_Utils._Validate(ObjectName, "ObjectName", V_STRING) Then GoTo Catch End If Try: ' Superclass or subclass property ? If ScriptForge.SF_Array.Contains([_Super].Properties(), PropertyName) Then GetProperty = [_Super].GetProperty(PropertyName) ElseIf Len(ObjectName) = 0 Then GetProperty = _PropertyGet(PropertyName) Else GetProperty = _PropertyGet(PropertyName, ObjectName) End If Finally: ScriptForge.SF_Utils._ExitFunction(cstThisSub) Exit Function Catch: GoTo Finally End Function ' SFDocuments.SF_Calc.GetProperty REM ----------------------------------------------------------------------------- Public Function GetValue(Optional ByVal Range As Variant) As Variant ''' Get the value(s) stored in the given range of cells ''' Args: ''' Range : the range as a string where to get the value from ''' Returns: ''' A scalar, a zero-based 1D array or a zero-based 2D array of strings and doubles ''' To convert doubles to dates, use the CDate builtin function ''' Examples: ''' Val = oDoc.GetValue("~.A1:A1000") Dim vGet As Variant ' Return value Dim oAddress As Object ' Alias of Range Dim vDataArray As Variant ' DataArray compatible with .DataArray UNO property Const cstThisSub = "SFDocuments.Calc.GetValue" Const cstSubArgs = "Range" If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch vGet = Empty Check: If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then If Not _IsStillAlive() Then GoTo Finally If Not ScriptForge.SF_Utils._Validate(Range, "Range", V_STRING) Then GoTo Finally End If Try: ' Get the data Set oAddress = _ParseAddress(Range) vDataArray = oAddress.XCellRange.getDataArray() ' Convert the data array to scalar, vector or array vGet = _ConvertFromDataArray(vDataArray) Finally: GetValue = vGet ScriptForge.SF_Utils._ExitFunction(cstThisSub) Exit Function Catch: GoTo Finally End Function ' SF_Documents.SF_Calc.GetValue REM ----------------------------------------------------------------------------- Public Function ImportFromCSVFile(Optional ByVal FileName As Variant _ , Optional ByVal DestinationCell As Variant _ , Optional ByVal FilterOptions As Variant _ ) As String ''' Import the content of a CSV-formatted text file starting from a given cell ''' Beforehand the destination area will be cleared from any content and format ''' Args: ''' FileName: Identifies the file to open. It must follow the SF_FileSystem.FileNaming notation ''' DestinationCell: the destination of the copied range of cells, as a string ''' If given as range, the destination will be reduced to its top-left cell ''' FilterOptions: The arguments of the CSV input filter. ''' Read https://wiki.openoffice.org/wiki/Documentation/DevGuide/Spreadsheets/Filter_Options#Filter_Options_for_the_CSV_Filter ''' Default: input file encoding is UTF8 ''' separator = comma, semi-colon or tabulation ''' string delimiter = double quote ''' all lines are included ''' quoted strings are formatted as texts ''' special numbers are detected ''' all columns are presumed texts ''' language = english/US => decimal separator is ".", thousands separator = "," ''' Returns: ''' A string representing the modified range of cells ''' The modified area depends only on the content of the source file ''' Exceptions: ''' DOCUMENTOPENERROR The csv file could not be opened ''' Examples: ''' oDoc.ImportFromCSVFile("C:\Temp\myCsvFile.csv", "SheetY.C5") Dim sImport As String ' Return value Dim oUI As Object ' UI service Dim oSource As Object ' New Calc document with csv loaded Dim oSelect As Object ' Current selection in destination Const cstFilter = "Text - txt - csv (StarCalc)" Const cstFilterOptions = "9/44/59/MRG,34,76,1,,1033,true,true" Const cstThisSub = "SFDocuments.Calc.ImportFromCSVFile" Const cstSubArgs = "FileName, DestinationCell, [FilterOptions]=""9/44/59/MRG,34,76,1,,1033,true,true""" ' If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch sImport = "" Check: If IsMissing(FilterOptions) Or IsEmpty(FilterOptions) Then FilterOptions = cstFilterOptions If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then If Not _IsStillAlive(True) Then GoTo Finally If Not ScriptForge.SF_Utils._ValidateFile(FileName, "FileName") Then GoTo Finally If Not ScriptForge.SF_Utils._Validate(DestinationCell, "DestinationCell", V_STRING) Then GoTo Finally End If Try: ' Input file is loaded in an empty worksheet. Data are copied to destination cell Set oUI = CreateScriptService("UI") Set oSource = oUI.OpenDocument(FileName _ , ReadOnly := True _ , Hidden := True _ , FilterName := cstFilter _ , FilterOptions := FilterOptions _ ) ' Remember current selection and restore it after copy Set oSelect = _Component.CurrentController.getSelection() sImport = CopyToCell(oSource.Range("*"), DestinationCell) _RestoreSelections(_Component, oSelect) Finally: If Not IsNull(oSource) Then oSource.CloseDocument(False) ImportFromCSVFile = sImport ScriptForge.SF_Utils._ExitFunction(cstThisSub) Exit Function Catch: GoTo Finally End Function ' SFDocuments.SF_Calc.ImportFromCSVFile REM ----------------------------------------------------------------------------- Public Sub ImportFromDatabase(Optional ByVal FileName As Variant _ , Optional ByVal RegistrationName As Variant _ , Optional ByVal DestinationCell As Variant _ , Optional ByVal SQLCommand As Variant _ , Optional ByVal DirectSQL As Variant _ ) ''' Import the content of a database table, query or resultset, i.e. the result of a SELECT SQL command, ''' starting from a given cell ''' Beforehand the destination area will be cleared from any content and format ''' The modified area depends only on the content of the source data ''' Args: ''' FileName: Identifies the file to open. It must follow the SF_FileSystem.FileNaming notation ''' RegistrationName: the name of a registered database ''' It is ignored if FileName <> "" ''' DestinationCell: the destination of the copied range of cells, as a string ''' If given as a range of cells, the destination will be reduced to its top-left cell ''' SQLCommand: either a table or query name (without square brackets) ''' or a full SQL commands where table and fieldnames are preferably surrounded with square brackets ''' Returns: ''' Implemented as a Sub because the doImport UNO method does not return any error ''' Exceptions: ''' BASEDOCUMENTOPENERROR The database file could not be opened ''' Examples: ''' oDoc.ImportFromDatabase("C:\Temp\myDbFile.odb", , "SheetY.C5", "SELECT * FROM [Employees] ORDER BY [LastName]") Dim oDBContext As Object ' com.sun.star.sdb.DatabaseContext Dim oDatabase As Object ' SFDatabases.Database service Dim lCommandType As Long ' A com.sun.star.sheet.DataImportMode.xxx constant Dim oQuery As Object ' com.sun.star.ucb.XContent Dim bDirect As Boolean ' Alias of DirectSQL Dim oDestRange As Object ' Destination as a range Dim oDestAddress As Object ' com.sun.star.table.CellRangeAddress Dim oDestCell As Object ' com.sun.star.table.XCell Dim oSelect As Object ' Current selection in destination Dim vImportOptions As Variant ' Array of PropertyValues Const cstThisSub = "SFDocuments.Calc.ImportFromDatabase" Const cstSubArgs = "[FileName=""""], [RegistrationName=""""], DestinationCell, SQLCommand, [DirectSQL=False]" ' If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch Check: If IsMissing(FileName) Or IsEmpty(FileName) Then FileName = "" If IsMissing(RegistrationName) Or IsEmpty(RegistrationName) Then RegistrationName = "" If IsMissing(DirectSQL) Or IsEmpty(DirectSQL) Then DirectSQL = False If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then If Not _IsStillAlive(True) Then GoTo Finally If Not ScriptForge.SF_Utils._ValidateFile(FileName, "FileName", , True) Then GoTo Finally If Not ScriptForge.SF_Utils._Validate(DestinationCell, "DestinationCell", V_STRING) Then GoTo Finally If Not ScriptForge.SF_Utils._Validate(SQLCommand, "SQLCommand", V_STRING) Then GoTo Finally If Not ScriptForge.SF_Utils._Validate(DirectSQL, "DirectSQL", ScriptForge.V_BOOLEAN) Then GoTo Finally End If ' Check the existence of FileName If Len(FileName) = 0 Then ' FileName has precedence over RegistrationName If Len(RegistrationName) = 0 Then GoTo CatchError Set oDBContext = ScriptForge.SF_Utils._GetUNOService("DatabaseContext") If Not oDBContext.hasRegisteredDatabase(RegistrationName) Then GoTo CatchError FileName = ScriptForge.SF_FileSystem._ConvertFromUrl(oDBContext.getDatabaseLocation(RegistrationName)) End If If Not ScriptForge.SF_FileSystem.FileExists(FileName) Then GoTo CatchError Try: ' Check command type Set oDatabase = ScriptForge.SF_Services.CreateScriptService("SFDatabases.Database", FileName, , True) ' Read-only If IsNull(oDatabase) Then GoTo CatchError With oDatabase If ScriptForge.SF_Array.Contains(.Tables, SQLCommand) Then bDirect = True lCommandType = com.sun.star.sheet.DataImportMode.TABLE ElseIf ScriptForge.SF_Array.Contains(.Queries, SQLCommand) Then Set oQuery = .XConnection.Queries.getByName(SQLCommand) bDirect = Not oQuery.EscapeProcessing lCommandType = com.sun.star.sheet.DataImportMode.QUERY Else bDirect = DirectSQL lCommandType = com.sun.star.sheet.DataImportMode.SQL SQLCommand = ._ReplaceSquareBrackets(SQLCommand) End If .CloseDatabase() Set oDatabase = oDatabase.Dispose() End With ' Determine the destination cell as the top-left coordinates of the given range Set oDestRange = _ParseAddress(DestinationCell) Set oDestAddress = oDestRange.XCellRange.RangeAddress Set oDestCell = oDestRange.XSpreadsheet.getCellByPosition(oDestAddress.StartColumn, oDestAddress.StartRow) ' Remember current selection Set oSelect = _Component.CurrentController.getSelection() ' Import arguments vImportOptions = Array(_ ScriptForge.SF_Utils._MakePropertyValue("DatabaseName", ScriptForge.SF_FileSystem._ConvertToUrl(FileName)) _ , ScriptForge.SF_Utils._MakePropertyValue("SourceObject", SQLCommand) _ , ScriptForge.SF_Utils._MakePropertyValue("SourceType", lCommandType) _ , ScriptForge.SF_Utils._MakePropertyValue("IsNative", bDirect) _ ) oDestCell.doImport(vImportOptions) ' Restore selection after import_ _RestoreSelections(_Component, oSelect) Finally: ScriptForge.SF_Utils._ExitFunction(cstThisSub) Exit Sub Catch: GoTo Finally CatchError: SF_Exception.RaiseFatal(BASEDOCUMENTOPENERROR, "FileName", FileName, "RegistrationName", RegistrationName) GoTo Finally End Sub ' SFDocuments.SF_Calc.ImportFromDatabase REM ----------------------------------------------------------------------------- Public Function InsertSheet(Optional ByVal SheetName As Variant _ , Optional ByVal BeforeSheet As Variant _ ) As Boolean ''' Insert a new empty sheet before an existing sheet or at the end of the list of sheets ''' Args: ''' SheetName: The name of the new sheet ''' BeforeSheet: The name (string) or index (numeric, starting from 1) of the sheet before which to insert ''' Returns: ''' True if the sheet could be inserted successfully ''' Examples: ''' oDoc.InsertSheet("SheetX", "SheetY") Dim bInsert As Boolean ' Return value Dim vSheets As Variant ' List of existing sheets Dim lSheetIndex As Long ' Index of a sheet Const cstThisSub = "SFDocuments.Calc.InsertSheet" Const cstSubArgs = "SheetName, [BeforeSheet=""""]" If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch bInsert = False Check: If IsMissing(BeforeSheet) Or IsEmpty(BeforeSheet) Then BeforeSheet = 32768 If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then If Not _IsStillAlive(True) Then GoTo Finally If Not _ValidateSheet(SheetName, "SheetName", True) Then GoTo Finally If Not _ValidateSheet(BeforeSheet, "BeforeSheet", , True, , True) Then GoTo Finally End If vSheets = _Component.getSheets.getElementNames() Try: If VarType(BeforeSheet) = V_STRING Then lSheetIndex = ScriptForge.SF_Array.IndexOf(vSheets, BeforeSheet) Else lSheetIndex = BeforeSheet - 1 If lSheetIndex < 0 Then lSheetIndex = 0 If lSheetIndex > UBound(vSheets) Then lSheetIndex = UBound(vSheets) + 1 End If _Component.getSheets.insertNewByName(SheetName, lSheetIndex) bInsert = True Finally: InsertSheet = binsert ScriptForge.SF_Utils._ExitFunction(cstThisSub) Exit Function Catch: GoTo Finally End Function ' SFDocuments.SF_Calc.InsertSheet REM ----------------------------------------------------------------------------- Public Function Methods() As Variant ''' Return the list of public methods of the Calc service as an array Methods = Array( _ "A1Style" _ , "Activate" _ , "Charts" _ , "ClearAll" _ , "ClearFormats" _ , "ClearValues" _ , "CloseDocument" _ , "CopySheet" _ , "CopySheetFromFile" _ , "CopyToCell" _ , "CopyToRange" _ , "CreateChart" _ , "DAvg" _ , "DCount" _ , "DMax" _ , "DMin" _ , "DSum" _ , "ExportAsPDF" _ , "GetColumnName" _ , "GetFormula" _ , "GetValue" _ , "ImportFromCSVFile" _ , "ImportFromDatabase" _ , "InsertSheet" _ , "MoveRange" _ , "MoveSheet" _ , "Offset" _ , "OpenRangeSelector" _ , "Printf" _ , "PrintOut" _ , "RemoveSheet" _ , "RenameSheet" _ , "RunCommand" _ , "Save" _ , "SaveAs" _ , "SaveCopyAs" _ , "SetArray" _ , "SetCellStyle" _ , "SetFormula" _ , "SetPrinter" _ , "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 ' SF_Documents.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 ' SF_Documents.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 ' SF_Documents.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" _ , "FirstCell" _ , "FirstColumn" _ , "FirstRow" _ , "Height" _ , "IsBase" _ , "IsCalc" _ , "IsDraw" _ , "IsImpress" _ , "IsMath" _ , "IsWriter" _ , "Keywords" _ , "LastCell" _ , "LastColumn" _ , "LastRow" _ , "Range" _ , "Readonly" _ , "Region" _ , "Sheet" _ , "SheetName" _ , "Sheets" _ , "Subject" _ , "Title" _ , "Width" _ , "XCellRange" _ , "XComponent" _ , "XSheetCellCursor" _ , "XSpreadsheet" _ ) End Function ' SFDocuments.SF_Calc.Properties REM ----------------------------------------------------------------------------- Public Function RemoveSheet(Optional ByVal SheetName As Variant) As Boolean ''' Remove an existing sheet from the document ''' Args: ''' SheetName: The name of the sheet to remove ''' Returns: ''' True if the sheet could be removed successfully ''' Examples: ''' oDoc.RemoveSheet("SheetX") Dim bRemove As Boolean ' Return value Const cstThisSub = "SFDocuments.Calc.RemoveSheet" Const cstSubArgs = "SheetName" If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch bRemove = False Check: If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then If Not _IsStillAlive(True) Then GoTo Finally If Not _ValidateSheet(SheetName, "SheetName", , True) Then GoTo Finally End If Try: _Component.getSheets.RemoveByName(SheetName) bRemove = True Finally: RemoveSheet = bRemove ScriptForge.SF_Utils._ExitFunction(cstThisSub) Exit Function Catch: GoTo Finally End Function ' SFDocuments.SF_Calc.RemoveSheet REM ----------------------------------------------------------------------------- Public Function RenameSheet(Optional ByVal SheetName As Variant _ , Optional ByVal NewName As Variant _ ) As Boolean ''' Rename a specified sheet ''' Args: ''' SheetName: The name of the sheet to rename ''' NewName: Must not exist ''' Returns: ''' True if the sheet could be renamed successfully ''' Exceptions: ''' DUPLICATESHEETERROR A sheet with the given name exists already ''' Examples: ''' oDoc.RenameSheet("SheetX", "SheetY") Dim bRename As Boolean ' Return value Const cstThisSub = "SFDocuments.Calc.RenameSheet" Const cstSubArgs = "SheetName, NewName" If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch bRename = False Check: If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then If Not _IsStillAlive(True) Then GoTo Finally If Not _ValidateSheet(SheetName, "SheetName", , True) Then GoTo Finally If Not _ValidateSheet(NewName, "NewName", True) Then GoTo Finally End If Try: _Component.getSheets.getByName(SheetName).setName(NewName) bRename = True Finally: RenameSheet = bRename ScriptForge.SF_Utils._ExitFunction(cstThisSub) Exit Function Catch: GoTo Finally End Function ' SFDocuments.SF_Calc.RenameSheet REM ----------------------------------------------------------------------------- Public Function SetArray(Optional ByVal TargetCell As Variant _ , Optional ByRef Value As Variant _ ) As String ''' Set the given (array of) values starting from the target cell ''' The updated area expands itself from the target cell or from the top-left corner of the given range ''' as far as determined by the size of the input Value. ''' Vectors are always expanded vertically ''' Args: ''' TargetCell : the cell or the range as a string that should receive a new value ''' Value: a scalar, a vector or an array with the new values ''' The new values should be strings, numeric values or dates. Other types empty the corresponding cell ''' Returns: ''' A string representing the updated range ''' Exceptions: ''' OFFSETADDRESSERROR The computed range of cells falls beyond the sheet boundaries ''' Examples: ''' oDoc.SetArray("SheetX.A1", SF_Array.RangeInit(1, 1000)) Dim sSet As String ' Return value Dim oSet As Object ' _Address alias of sSet Dim vDataArray As Variant ' DataArray compatible with .DataArray UNO property Const cstThisSub = "SFDocuments.Calc.SetArray" Const cstSubArgs = "TargetCell, Value" If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch sSet = "" Check: If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then If Not _IsStillAlive() Then GoTo Finally If Not ScriptForge.SF_Utils._Validate(TargetCell, "TargetCell", V_STRING) Then GoTo Finally If IsArray(Value) Then If Not ScriptForge.SF_Utils._ValidateArray(Value, "Value") Then GoTo Finally Else If Not ScriptForge.SF_Utils._Validate(Value, "Value") Then GoTo Finally End If End If Try: ' Convert argument to data array and derive new range from its size vDataArray = _ConvertToDataArray(Value) If UBound(vDataArray) < LBound(vDataArray) Then GoTo Finally Set oSet = _Offset(TargetCell, 0, 0, plHeight := UBound(vDataArray) + 1, plWidth := UBound(vDataArray(0)) + 1) ' +1 : vDataArray is zero-based With oSet .XCellRange.setDataArray(vDataArray) sSet = .RangeName End With Finally: SetArray = sSet ScriptForge.SF_Utils._ExitFunction(cstThisSub) Exit Function Catch: GoTo Finally End Function ' SF_Documents.SF_Calc.SetArray REM ----------------------------------------------------------------------------- Public Function SetCellStyle(Optional ByVal TargetRange As Variant _ , Optional ByVal Style As Variant _ ) As String ''' Apply the given cell style in the given range ''' The full range is updated and the remainder of the sheet is left untouched ''' If the cell style does not exist, an error is raised ''' Args: ''' TargetRange : the range as a string that should receive a new cell style ''' Style: the style name as a string ''' Returns: ''' A string representing the updated range ''' Examples: ''' oDoc.SetCellStyle("A1:F1", "Heading 2") Dim sSet As String ' Return value Dim oAddress As _Address ' Alias of TargetRange Dim oStyleFamilies As Object ' com.sun.star.container.XNameAccess Dim vStyles As Variant ' Array of existing cell styles Const cstStyle = "CellStyles" Const cstThisSub = "SFDocuments.Calc.SetCellStyle" Const cstSubArgs = "TargetRange, Style" If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch sSet = "" Check: If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then If Not _IsStillAlive() Then GoTo Finally If Not ScriptForge.SF_Utils._Validate(TargetRange, "TargetRange", V_STRING) Then GoTo Finally Set oStyleFamilies = _Component.StyleFamilies If oStyleFamilies.hasByName(cstStyle) Then vStyles = oStyleFamilies.getByName(cstStyle).getElementNames() Else vStyles = Array() If Not ScriptForge.SF_Utils._Validate(Style, "Style", V_STRING, vStyles) Then GoTo Finally End If Try: Set oAddress = _ParseAddress(TargetRange) With oAddress .XCellRange.CellStyle = Style sSet = .RangeName End With Finally: SetCellStyle = sSet ScriptForge.SF_Utils._ExitFunction(cstThisSub) Exit Function Catch: GoTo Finally End Function ' SF_Documents.SF_Calc.SetCellStyle REM ----------------------------------------------------------------------------- Public Function SetFormula(Optional ByVal TargetRange As Variant _ , Optional ByRef Formula As Variant _ ) As String ''' Set the given (array of) formulae in the given range ''' The full range is updated and the remainder of the sheet is left untouched ''' If the given formula is a string: ''' the unique formula is pasted across the whole range with adjustment of the relative references ''' Otherwise ''' If the size of Formula < the size of Range, then the other cells are emptied ''' If the size of Formula > the size of Range, then Formula is only partially copied ''' Vectors are always expanded vertically, except if the range has a height of exactly 1 row ''' Args: ''' TargetRange : the range as a string that should receive a new Formula ''' Formula: a scalar, a vector or an array with the new formula(e) as strings for each cell of the range. ''' Returns: ''' A string representing the updated range ''' Examples: ''' oDoc.SetFormula("A1", "=A2") ''' oDoc.SetFormula("A1:F1", Array("=A2", "=B2", "=C2+10")) ' Horizontal vector, partially empty ''' oDoc.SetFormula("A1:D2", "=E1") ' D2 contains the formula "=H2" Dim sSet As String ' Return value.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", V_STRING) Then GoTo Finally If IsArray(Formula) Then If Not ScriptForge.SF_Utils._ValidateArray(Formula, "Formula", 0, V_STRING) Then GoTo Finally Else If Not ScriptForge.SF_Utils._Validate(Formula, "Formula", V_STRING) Then GoTo Finally End If End If Try: Set oAddress = _ParseAddress(TargetRange) With oAddress If IsArray(Formula) Then ' Convert to data array and limit its size to the size of the initial range vDataArray = _ConvertToDataArray(Formula, .Height - 1, .Width - 1) If UBound(vDataArray) < LBound(vDataArray) Then GoTo Finally .XCellRange.setFormulaArray(vDataArray) Else With .XCellRange ' Store formula in top-left cell and paste it along the whole range .getCellByPosition(0, 0).setFormula(Formula) .fillSeries(com.sun.star.sheet.FillDirection.TO_BOTTOM, com.sun.star.sheet.FillMode.SIMPLE, 0, 0, 0) .fillSeries(com.sun.star.sheet.FillDirection.TO_RIGHT, com.sun.star.sheet.FillMode.SIMPLE, 0, 0, 0) End With End If sSet = .RangeName End With Finally: SetFormula = sSet ScriptForge.SF_Utils._ExitFunction(cstThisSub) Exit Function Catch: GoTo Finally End Function ' SF_Documents.SF_Calc.SetFormula REM ----------------------------------------------------------------------------- Private Function SetProperty(Optional ByVal psProperty As String _ , Optional ByVal pvValue As Variant _ ) As Boolean ''' Set the new value of the named property ''' Args: ''' psProperty: the name of the property ''' pvValue: the new value of the given property ''' Returns: ''' True if successful Dim bSet As Boolean ' Return value Static oSession As Object ' Alias of SF_Session Dim cstThisSub As String Const cstSubArgs = "Value" If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch bSet = False cstThisSub = "SFDocuments.Calc.set" & psProperty If IsMissing(pvValue) Then pvValue = Empty 'ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) ' Validation done in Property Lets If IsNull(oSession) Then Set oSession = ScriptForge.SF_Services.CreateScriptService("Session") bSet = True Select Case UCase(psProperty) Case UCase("CurrentSelection") CurrentSelection = pvValue Case UCase("CustomProperties") CustomProperties = pvValue Case UCase("Description") Description = pvValue Case UCase("Keywords") Keywords = pvValue Case UCase("Subject") Subject = pvValue Case UCase("Title") Title = pvValue Case Else bSet = False End Select Finally: SetProperty = bSet 'ScriptForge.SF_Utils._ExitFunction(cstThisSub) Exit Function Catch: GoTo Finally End Function ' SFDocuments.SF_Calc.SetProperty REM ----------------------------------------------------------------------------- Public Function SetValue(Optional ByVal TargetRange As Variant _ , Optional ByRef Value As Variant _ ) As String ''' Set the given value in the given range ''' The full range is updated and the remainder of the sheet is left untouched ''' If the size of Value < the size of Range, then the other cells are emptied ''' If the size of Value > the size of Range, then Value is only partially copied ''' Vectors are always expanded vertically, except if the range has a height of exactly 1 row ''' Args: ''' TargetRange : the range as a string that should receive a new value ''' Value: a scalar, a vector or an array with the new values for each cell 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 ' SF_Documents.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) 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) 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 maximum 3 columns/rows. The sorting order may vary by column/row ''' Args: ''' Range: the range to sort as a string ''' SortKeys: a scalar (if 1 column/row) or an array of column/row numbers starting from 1 ''' SortOrder: a scalar or an array of strings: "ASC" or "DESC" ''' Each item is paired with the corresponding item in SortKeys ''' If the SortOrder array is shorter than SortKeys, the remaining keys are sorted ''' in ascending order ''' DestinationCell: the destination of the sorted range of cells, as a string ''' If given as range, the destination will be reduced to its top-left cell ''' By default, Range is overwritten with its sorted content ''' ContainsHeader: when True, the first row/column is not sorted. Default = False ''' CaseSensitive: only for string comparisons, default = False ''' SortColumns: when True, the columns are sorted from left to right ''' Default = False: rows are sorted from top to bottom. ''' Returns: ''' The modified range of cells as a string ''' Example: ''' oDoc.SortRange("A2:J200", Array(1, 3), , Array("ASC", "DESC"), CaseSensitive := True) ''' ' Sort on columns A (ascending) and C (descending) Dim sSort As String ' Return value Dim oRangeAddress As _Address ' Parsed range Dim oRange As Object ' com.sun.star.table.XCellRange Dim oDestRange As Object ' Destination as a range Dim oDestAddress As Object ' com.sun.star.table.CellRangeAddress Dim oDestCell As Object ' com.sun.star.table.CellAddress Dim vSortDescriptor As Variant ' Array of com.sun.star.beans.PropertyValue Dim vSortFields As Variant ' Array of com.sun.star.table.TableSortField Dim sOrder As String ' Item in SortOrder Dim i As Long Const cstThisSub = "SFDocuments.Calc.SortRange" Const cstSubArgs = "Range, SortKeys, [TargetRange=""""], [SortOrder=""ASC""], [DestinationCell=""""], [ContainsHeader=False], [CaseSensitive=False], [SortColumns=False]" If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch sSort = "" Check: If IsMissing(SortKeys) Or IsEmpty(SortKeys) Then SortKeys = Array(1) ElseIf Not IsArray(SortKeys) Then SortKeys = Array(SortKeys) End If If IsMissing(DestinationCell) Or IsEmpty(DestinationCell) Then DestinationCell = "" If IsMissing(SortOrder) Or IsEmpty(SortOrder) Then SortOrder = Array("ASC") ElseIf Not IsArray(SortOrder) Then SortOrder = Array(SortOrder) End If If IsMissing(ContainsHeader) Or IsEmpty(ContainsHeader) Then ContainsHeader = False If IsMissing(CaseSensitive) Or IsEmpty(CaseSensitive) Then CaseSensitive = False If IsMissing(SortColumns) Or IsEmpty(SortColumns) Then SortColumns = False If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then If Not _IsStillAlive() Then GoTo Finally If Not ScriptForge.SF_Utils._Validate(Range, "Range", V_STRING) Then GoTo Finally If Not ScriptForge.SF_Utils._ValidateArray(SortKeys, "SortKeys", 1, V_NUMERIC, True) Then GoTo Finally If Not ScriptForge.SF_Utils._Validate(DestinationCell, "DestinationCell", V_STRING) Then GoTo Finally If Not ScriptForge.SF_Utils._ValidateArray(SortOrder, "SortOrder", 1, V_STRING, True) Then GoTo Finally If Not ScriptForge.SF_Utils._Validate(ContainsHeader, "ContainsHeader", V_BOOLEAN) Then GoTo Finally If Not ScriptForge.SF_Utils._Validate(CaseSensitive, "CaseSensitive", V_BOOLEAN) Then GoTo Finally If Not ScriptForge.SF_Utils._Validate(SortColumns, "SortColumns", V_BOOLEAN) Then GoTo Finally End If Set oRangeAddress = _ParseAddress(Range) If Len(DestinationCell) > 0 Then Set oDestRange = _ParseAddress(DestinationCell) Try: ' Initialize the sort descriptor Set oRange = oRangeAddress.XCellRange vSortDescriptor = oRange.createSortDescriptor vSortDescriptor = ScriptForge.SF_Utils._SetPropertyValue(vSortDescriptor, "IsSortColumns", SortColumns) vSortDescriptor = ScriptForge.SF_Utils._SetPropertyValue(vSortDescriptor, "ContainsHeader", ContainsHeader) vSortDescriptor = ScriptForge.SF_Utils._SetPropertyValue(vSortDescriptor, "BindFormatsToContent", True) If Len(DestinationCell) = 0 Then vSortDescriptor = ScriptForge.SF_Utils._SetPropertyValue(vSortDescriptor, "CopyOutputData", False) Else Set oDestAddress = oDestRange.XCellRange.RangeAddress Set oDestCell = New com.sun.star.table.CellAddress With oDestAddress oDestCell.Sheet = .Sheet oDestCell.Column = .StartColumn oDestCell.Row = .StartRow End With vSortDescriptor = ScriptForge.SF_Utils._SetPropertyValue(vSortDescriptor, "CopyOutputData", True) vSortDescriptor = ScriptForge.SF_Utils._SetPropertyValue(vSortDescriptor, "OutputPosition", oDestCell) End If vSortDescriptor = ScriptForge.SF_Utils._SetPropertyValue(vSortDescriptor, "IsUserListEnabled", False) ' Define the sorting keys vSortFields = Array() ReDim vSortFields(0 To UBound(SortKeys)) For i = 0 To UBound(SortKeys) vSortFields(i) = New com.sun.star.table.TableSortField If i > UBound(SortOrder) Then sOrder = "" Else sOrder = SortOrder(i) If Len(sOrder) = 0 Then sOrder = "ASC" With vSortFields(i) .Field = SortKeys(i) - 1 .IsAscending = ( UCase(sOrder) = "ASC" ) .IsCaseSensitive = CaseSensitive End With Next i ' Associate the keys and the descriptor, and sort vSortDescriptor = ScriptForge.SF_Utils._SetPropertyValue(vSortDescriptor, "SortFields", vSortFields) oRange.sort(vSortDescriptor) ' Compute the changed area If Len(DestinationCell) = 0 Then sSort = oRangeAddress.RangeName Else With oRangeAddress sSort = _Offset(oDestRange, 0, 0, .Height, .Width).RangeName End With End If Finally: SortRange = sSort ScriptForge.SF_Utils._ExitFunction(cstThisSub) Exit Function Catch: GoTo Finally End Function ' SF_Documents.SF_Calc.SortRange REM ======================================================= SUPERCLASS PROPERTIES REM ----------------------------------------------------------------------------- Property Get CustomProperties() As Variant CustomProperties = [_Super].GetProperty("CustomProperties") End Property ' SFDocuments.SF_Calc.CustomProperties REM ----------------------------------------------------------------------------- Property Let CustomProperties(Optional ByVal pvCustomProperties As Variant) [_Super].CustomProperties = pvCustomProperties End Property ' SFDocuments.SF_Calc.CustomProperties REM ----------------------------------------------------------------------------- Property Get Description() As Variant Description = [_Super].GetProperty("Description") End Property ' SFDocuments.SF_Calc.Description REM ----------------------------------------------------------------------------- Property Let Description(Optional ByVal pvDescription As Variant) [_Super].Description = pvDescription End Property ' SFDocuments.SF_Calc.Description REM ----------------------------------------------------------------------------- Property Get DocumentProperties() As Variant DocumentProperties = [_Super].GetProperty("DocumentProperties") End Property ' SFDocuments.SF_Calc.DocumentProperties REM ----------------------------------------------------------------------------- Property Get DocumentType() As String DocumentType = [_Super].GetProperty("DocumentType") End Property ' SFDocuments.SF_Calc.DocumentType REM ----------------------------------------------------------------------------- Property Get IsBase() As Boolean IsBase = [_Super].GetProperty("IsBase") End Property ' SFDocuments.SF_Calc.IsBase REM ----------------------------------------------------------------------------- Property Get IsCalc() As Boolean IsCalc = [_Super].GetProperty("IsCalc") End Property ' SFDocuments.SF_Calc.IsCalc REM ----------------------------------------------------------------------------- Property Get IsDraw() As Boolean IsDraw = [_Super].GetProperty("IsDraw") End Property ' SFDocuments.SF_Calc.IsDraw REM ----------------------------------------------------------------------------- Property Get IsImpress() As Boolean IsImpress = [_Super].GetProperty("IsImpress") End Property ' SFDocuments.SF_Calc.IsImpress REM ----------------------------------------------------------------------------- Property Get IsMath() As Boolean IsMath = [_Super].GetProperty("IsMath") End Property ' SFDocuments.SF_Calc.IsMath REM ----------------------------------------------------------------------------- Property Get IsWriter() As Boolean IsWriter = [_Super].GetProperty("IsWriter") End Property ' SFDocuments.SF_Calc.IsWriter REM ----------------------------------------------------------------------------- Property Get Keywords() As Variant Keywords = [_Super].GetProperty("Keywords") End Property ' SFDocuments.SF_Calc.Keywords REM ----------------------------------------------------------------------------- Property Let Keywords(Optional ByVal pvKeywords As Variant) [_Super].Keywords = pvKeywords End Property ' SFDocuments.SF_Calc.Keywords REM ----------------------------------------------------------------------------- Property Get Readonly() As Variant Readonly = [_Super].GetProperty("Readonly") End Property ' SFDocuments.SF_Calc.Readonly REM ----------------------------------------------------------------------------- Property Get Subject() As Variant Subject = [_Super].GetProperty("Subject") End Property ' SFDocuments.SF_Calc.Subject REM ----------------------------------------------------------------------------- Property Let Subject(Optional ByVal pvSubject As Variant) [_Super].Subject = pvSubject End Property ' SFDocuments.SF_Calc.Subject REM ----------------------------------------------------------------------------- Property Get Title() As Variant Title = [_Super].GetProperty("Title") End Property ' SFDocuments.SF_Calc.Title REM ----------------------------------------------------------------------------- Property Let Title(Optional ByVal pvTitle As Variant) [_Super].Title = pvTitle End Property ' SFDocuments.SF_Calc.Title REM ----------------------------------------------------------------------------- Property Get XComponent() As Variant XComponent = [_Super].GetProperty("XComponent") End Property ' SFDocuments.SF_Calc.XComponent REM ========================================================== SUPERCLASS METHODS REM ----------------------------------------------------------------------------- 'Public Function Activate() As Boolean ' Activate = [_Super].Activate() 'End Function ' SFDocuments.SF_Calc.Activate REM ----------------------------------------------------------------------------- Public Function CloseDocument(Optional ByVal SaveAsk As Variant) As Boolean CloseDocument = [_Super].CloseDocument(SaveAsk) End Function ' SFDocuments.SF_Calc.CloseDocument REM ----------------------------------------------------------------------------- Public Function ExportAsPDF(Optional ByVal FileName As Variant _ , Optional ByVal Overwrite As Variant _ , Optional ByVal Pages As Variant _ , Optional ByVal Password As Variant _ , Optional ByVal Watermark As Variant _ ) As Boolean ExportAsPDF = [_Super].ExportAsPDF(FileName, Overwrite, Pages, Password, Watermark) End Function ' SFDocuments.SF_Calc.ExportAsPDF REM ----------------------------------------------------------------------------- Public Sub RunCommand(Optional ByVal Command As Variant) [_Super].RunCommand(Command) End Sub ' SFDocuments.SF_Calc.RunCommand REM ----------------------------------------------------------------------------- Public Function Save() As Boolean Save = [_Super].Save() End Function ' SFDocuments.SF_Calc.Save REM ----------------------------------------------------------------------------- Public Function SaveAs(Optional ByVal FileName As Variant _ , Optional ByVal Overwrite As Variant _ , Optional ByVal Password As Variant _ , Optional ByVal FilterName As Variant _ , Optional ByVal FilterOptions As Variant _ ) As Boolean SaveAs = [_Super].SaveAs(FileName, Overwrite, Password, FilterName, FilterOptions) End Function ' SFDocuments.SF_Calc.SaveAs REM ----------------------------------------------------------------------------- Public Function SaveCopyAs(Optional ByVal FileName As Variant _ , Optional ByVal Overwrite As Variant _ , Optional ByVal Password As Variant _ , Optional ByVal FilterName As Variant _ , Optional ByVal FilterOptions As Variant _ ) As Boolean SaveCopyAs = [_Super].SaveCopyAs(FileName, Overwrite, Password, FilterName, FilterOptions) End Function ' SFDocuments.SF_Calc.SaveCopyAs REM ----------------------------------------------------------------------------- Public Function SetPrinter(Optional ByVal Printer As Variant _ , Optional ByVal Orientation As Variant _ , Optional ByVal PaperFormat As Variant _ ) As Boolean SetPrinter = [_Super].SetPrinter(Printer, Orientation, PaperFormat) End Function ' SFDocuments.SF_Calc.SetPrinter REM =========================================================== PRIVATE FUNCTIONS REM ----------------------------------------------------------------------------- Public Function _ConvertFromDataArray(ByRef pvDataArray As Variant) As Variant ''' Convert a data array to a scalar, a vector or a 2D array ''' Args: ''' pvDataArray: an array as returned by the XCellRange.getDataArray or .getFormulaArray methods ''' Returns: ''' A scalar, a zero-based 1D array or a zero-based 2D array of strings and/or doubles ''' To convert doubles to dates, use the CDate builtin function Dim vArray As Variant ' Return value Dim lMax1 As Long ' UBound of pvDataArray Dim lMax2 As Long ' UBound of pvDataArray items Dim i As Long Dim j As Long vArray = Empty Try: ' Convert the data array to scalar, vector or array lMax1 = UBound(pvDataArray) If lMax1 >= 0 Then lMax2 = UBound(pvDataArray(0)) If lMax2 >= 0 Then If lMax1 + lMax2 > 0 Then vArray = Array() Select Case True Case lMax1 = 0 And lMax2 = 0 ' Scalar vArray = pvDataArray(0)(0) Case lMax1 > 0 And lMax2 = 0 ' Vertical vector ReDim vArray(0 To lMax1) For i = 0 To lMax1 vArray(i) = pvDataArray(i)(0) Next i Case lMax1 = 0 And lMax2 > 0 ' Horizontal vector ReDim vArray(0 To lMax2) For j = 0 To lMax2 vArray(j) = pvDataArray(0)(j) Next j Case Else ' Array ReDim vArray(0 To lMax1, 0 To lMax2) For i = 0 To lMax1 For j = 0 To lMax2 vArray(i, j) = pvDataArray(i)(j) Next j Next i End Select End If End If Finally: _ConvertFromDataArray = vArray End Function ' SF_Documents.SF_Calc._ConvertFromDataArray REM ----------------------------------------------------------------------------- Private Function _ConvertToCellValue(ByVal pvItem As Variant) As Variant ''' Convert the argument to a valid Calc cell content Dim vCell As Variant ' Return value Try: Select Case ScriptForge.SF_Utils._VarTypeExt(pvItem) Case V_STRING : vCell = pvItem Case V_DATE : vCell = CDbl(pvItem) Case ScriptForge.V_NUMERIC : vCell = CDbl(pvItem) Case ScriptForge.V_BOOLEAN : vCell = CDbl(Iif(pvItem, 1, 0)) Case Else : vCell = "" End Select Finally: _ConvertToCellValue = vCell Exit Function End Function ' SF_Documents.SF_Calc._ConvertToCellValue REM ----------------------------------------------------------------------------- Private Function _ConvertToDataArray(ByRef pvArray As Variant _ , Optional ByVal plRows As Long _ , Optional ByVal plColumns As Long _ ) As Variant ''' Create a 2-dimensions nested array (compatible with the ranges .DataArray property) ''' from a scalar, a 1D array or a 2D array ''' Input may be a 1D array of arrays, typically when call issued by a Python script ''' Array items are converted to (possibly empty) strings or doubles ''' Args: ''' pvArray: the input scalar or array. If array, must be 1 or 2D otherwise it is ignored. ''' plRows, plColumns: the upper bounds of the data array ''' If bigger than input array, fill with zero-length strings ''' If smaller than input array, truncate ''' If plRows = 0 and the input array is a vector, the data array is aligned horizontally ''' They are either both present or both absent ''' When absent ''' The size of the output is fully determined by the input array ''' Vectors are aligned vertically ''' Returns: ''' A data array compatible with ranges .DataArray property ''' The output is always an array of nested arrays Dim vDataArray() As Variant ' Return value Dim vVector() As Variant ' A temporary 1D array Dim vItem As Variant ' A single input item Dim iDims As Integer ' Number of dimensions of the input argument Dim lMin1 As Long ' Lower bound (1) of input array Dim lMax1 As Long ' Upper bound (1) Dim lMin2 As Long ' Lower bound (2) Dim lMax2 As Long ' Upper bound (2) Dim lRows As Long ' Upper bound of vDataArray Dim lCols As Long ' Upper bound of vVector Dim bHorizontal As Boolean ' Horizontal vector Dim bDataArray As Boolean ' Input array is already an array of arrays Dim i As Long Dim j As Long Const cstEmpty = "" ' Empty cell If IsMissing(plRows) Or IsEmpty(plRows) Then plRows = -1 If IsMissing(plColumns) Or IsEmpty(plColumns) Then plColumns = -1 vDataArray = Array() Try: ' Check the input argument and know its boundaries iDims = ScriptForge.SF_Array.CountDims(pvArray) If iDims = 0 Or iDims > 2 Then Exit Function lMin1 = 0 : lMax1 = 0 ' Default values lMin2 = 0 : lMax2 = 0 Select Case iDims Case -1 ' Scalar value Case 1 bHorizontal = ( plRows = 0 And plColumns > 0 ) bDataArray = IsArray(pvArray(0)) If Not bDataArray Then If Not bHorizontal Then lMin1 = LBound(pvArray) : lMax1 = UBound(pvArray) Else lMin2 = LBound(pvArray) : lMax2 = UBound(pvArray) End If Else iDims = 2 lMin1 = LBound(pvArray) : lMax1 = UBound(pvArray) lMin2 = LBound(pvArray(0)) : lMax2 = UBound(pvArray(0)) End If Case 2 lMin1 = LBound(pvArray, 1) : lMax1 = UBound(pvArray, 1) lMin2 = LBound(pvArray, 2) : lMax2 = UBound(pvArray, 2) End Select ' Set the output dimensions accordingly If plRows >= 0 Then ' Dimensions of output are imposed lRows = plRows lCols = plColumns Else ' Dimensions of output determined by input argument lRows = 0 : lCols = 0 ' Default values Select Case iDims Case -1 ' Scalar value Case 1 ' Vectors are aligned vertically lRows = lMax1 - lMin1 Case 2 lRows = lMax1 - lMin1 lCols = lMax2 - lMin2 End Select End If ReDim vDataArray(0 To lRows) ' Feed the output array row by row, each row being a vector For i = 0 To lRows ReDim vVector(0 To lCols) For j = 0 To lCols If i > lMax1 - lMin1 Then vVector(j) = cstEmpty ElseIf j > lMax2 - lMin2 Then vVector(j) = cstEmpty Else Select Case iDims Case -1 : vItem = _ConvertToCellValue(pvArray) Case 1 If bHorizontal Then vItem = _ConvertToCellValue(pvArray(j + lMin2)) Else vItem = _ConvertToCellValue(pvArray(i + lMin1)) End If Case 2 If bDataArray Then vItem = _ConvertToCellValue(pvArray(i + lMin1)(j + lMin2)) Else vItem = _ConvertToCellValue(pvArray(i + lMin1, j + lMin2)) End If End Select vVector(j) = vItem End If vDataArray(i) = vVector Next j Next i Finally: _ConvertToDataArray = vDataArray Exit Function End Function ' SF_Documents.SF_Calc._ConvertToDataArray REM ----------------------------------------------------------------------------- Private Function _DFunction(ByVal psFunction As String _ , Optional ByVal Range As Variant _ ) As Double ''' Apply the given function on all the numeric values stored in the given range ''' Args: ''' Range : the range as a string where to apply the function on ''' Returns: ''' The resulting value as a double Dim dblGet As Double ' Return value Dim oAddress As Object ' Alias of Range Dim vFunction As Variant ' com.sun.star.sheet.GeneralFunction.XXX Dim cstThisSub As String : cstThisSub = "SFDocuments.Calc." & psFunction Const cstSubArgs = "Range" If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch dblGet = 0 Check: If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then If Not _IsStillAlive() Then GoTo Finally If Not ScriptForge.SF_Utils._Validate(Range, "Range", V_STRING) Then GoTo Finally End If Try: ' Get the data Set oAddress = _ParseAddress(Range) Select Case psFunction Case "DAvg" : vFunction = com.sun.star.sheet.GeneralFunction.AVERAGE Case "DCount" : vFunction = com.sun.star.sheet.GeneralFunction.COUNTNUMS Case "DMax" : vFunction = com.sun.star.sheet.GeneralFunction.MAX Case "DMin" : vFunction = com.sun.star.sheet.GeneralFunction.MIN Case "DSum" : vFunction = com.sun.star.sheet.GeneralFunction.SUM Case Else : GoTo Finally End Select dblGet = oAddress.XCellRange.computeFunction(vFunction) Finally: _DFunction = dblGet ScriptForge.SF_Utils._ExitFunction(cstThisSub) Exit Function Catch: GoTo Finally End Function ' SF_Documents.SF_Calc._DFunction REM ----------------------------------------------------------------------------- Private Function _FileIdent() As String ''' Returns a file identification from the information that is currently available ''' Useful e.g. for display in error messages _FileIdent = [_Super]._FileIdent() End Function ' SFDocuments.SF_Calc._FileIdent REM ----------------------------------------------------------------------------- Function _GetColumnName(ByVal plColumnNumber As Long) As String ''' Convert a column number (range 1, 2,..1024) into its letter counterpart (range 'A', 'B',..'AMJ'). ''' Args: ''' ColumnNumber: the column number, must be in the interval 1 ... 1024 ''' Returns: ''' a string representation of the column name, in range 'A'..'AMJ' ''' Adapted from a Python function by sundar nataraj ''' http://stackoverflow.com/questions/23861680/convert-spreadsheet-number-to-column-letter Dim sCol As String ' Return value Dim lDiv As Long ' Intermediate result Dim lMod As Long ' Result of modulo 26 operation Try: lDiv = plColumnNumber Do While lDiv > 0 lMod = (lDiv - 1) Mod 26 sCol = Chr(65 + lMod) + sCol lDiv = Int((lDiv - lMod)/26) Loop Finally: _GetColumnName = sCol End Function ' SFDocuments.SF_Calc._GetColumnName REM ----------------------------------------------------------------------------- Private Function _IsStillAlive(Optional ByVal pbForUpdate As Boolean _ , Optional ByVal pbError As Boolean _ ) As Boolean ''' Returns True if the document has not been closed manually or incidentally since the last use ''' If dead the actual instance is disposed. The execution is cancelled when pbError = True (default) ''' Args: ''' pbForUpdate: if True (default = False), check additionally if document is open for editing ''' pbError: if True (default), raise a fatal error Dim bAlive As Boolean ' Return value If IsMissing(pbForUpdate) Then pbForUpdate = False If IsMissing(pbError) Then pbError = True Try: bAlive = [_Super]._IsStillAlive(pbForUpdate, pbError) Finally: _IsStillAlive = bAlive Exit Function End Function ' SFDocuments.SF_Calc._IsStillAlive REM ----------------------------------------------------------------------------- Private Function _LastCell(ByRef poSheet As Object) As Variant ''' Returns in an array the coordinates of the last used cell in the given sheet Dim oCursor As Object ' Cursor on the cell Dim oRange As Object ' The used range Dim vCoordinates(0 To 1) As Long ' Return value: (0) = Column, (1) = Row Try: Set oCursor = poSheet.createCursorByRange(poSheet.getCellRangeByName("A1")) oCursor.gotoEndOfUsedArea(True) Set oRange = poSheet.getCellRangeByName(oCursor.AbsoluteName) vCoordinates(0) = oRange.RangeAddress.EndColumn + 1 vCoordinates(1) = oRange.RangeAddress.EndRow + 1 Finally: _LastCell = vCoordinates End Function ' SFDocuments.SF_Calc._LastCell REM ----------------------------------------------------------------------------- Public Function _Offset(ByRef pvRange As Variant _ , ByVal plRows As Long _ , ByVal plColumns As Long _ , ByVal plHeight As Long _ , ByVal plWidth As Long _ ) As Object ''' Returns a new range offset by a certain number of rows and columns from a given range ''' Args: ''' pvRange : the range, as a string or an object, from which the function searches for the new range ''' plRows : the number of rows by which the reference was corrected up (negative value) or down. ''' plColumns : the number of columns by which the reference was corrected to the left (negative value) or to the right. ''' plHeight : the vertical height for an area that starts at the new reference position. ''' plWidth : the horizontal width for an area that starts at the new reference position. ''' Arguments Rows and Columns must not lead to zero or negative start row or column. ''' Arguments Height and Width must not lead to zero or negative count of rows or columns. ''' Returns: ''' A new range as object of type _Address ''' Exceptions: ''' OFFSETADDRESSERROR The computed range of cells falls beyond the sheet boundaries Dim oOffset As Object ' Return value Dim oAddress As Object ' Alias of Range Dim oSheet As Object ' com.sun.star.sheet.XSpreadsheet Dim oRange As Object ' com.sun.star.table.XCellRange Dim oNewRange As Object ' com.sun.star.table.XCellRange Dim lLeft As Long ' New range coordinates Dim lTop As Long Dim lRight As Long Dim lBottom As Long Set oOffset = Nothing Check: If plHeight < 0 Or plWidth < 0 Then GoTo CatchAddress Try: If VarType(pvRange) = V_STRING Then Set oAddress = _ParseAddress(pvRange) Else Set oAddress = pvRange Set oSheet = oAddress.XSpreadSheet Set oRange = oAddress.XCellRange.RangeAddress ' Compute and validate new coordinates With oRange lLeft = .StartColumn + plColumns lTop = .StartRow + plRows lRight = lLeft + Iif(plWidth = 0, .EndColumn - .StartColumn, plWidth - 1) lBottom = lTop + Iif(plHeight = 0, .EndRow - .StartRow, plHeight - 1) If lLeft < 0 Or lRight < 0 Or lTop < 0 Or lBottom < 0 _ Or lLeft > MAXCOLS Or lRight > MAXCOLS _ Or lTop > MAXROWS Or lBottom > MAXROWS _ Then GoTo CatchAddress Set oNewRange = oSheet.getCellRangeByPosition(lLeft, lTop, lRight, lBottom) End With ' Define the new range address Set oOffset = New _Address With oOffset .ObjectType = CALCREFERENCE .ServiceName = SERVICEREFERENCE .RawAddress = oNewRange.AbsoluteName .Component = _Component .XSpreadsheet = oNewRange.Spreadsheet .SheetName = .XSpreadsheet.Name .SheetIndex = .XSpreadsheet.RangeAddress.Sheet .RangeName = .RawAddress .XCellRange = oNewRange .Height = oNewRange.RangeAddress.EndRow - oNewRange.RangeAddress.StartRow + 1 .Width = oNewRange.RangeAddress.EndColumn - oNewRange.RangeAddress.StartColumn + 1 End With Finally: Set _Offset = oOffset Exit Function Catch: GoTo Finally CatchAddress: ScriptForge.SF_Exception.RaiseFatal(OFFSETADDRESSERROR, "Range", oAddress.RawAddress _ , "Rows", plRows, "Columns", plColumns, "Height", plHeight, "Width", plWidth _ , "Document", [_Super]._FileIdent()) GoTo Finally End Function ' SF_Documents.SF_Calc._Offset REM ----------------------------------------------------------------------------- Private Function _ParseAddress(ByVal psAddress As String) As Object ''' Parse and validate a sheet or range reference ''' Syntax to parse: ''' [Sheet].[Range] ''' Sheet => ['][$]sheet['] or document named range or ~ ''' Range => A1:D10, A1, A:D, 10:10 ($ ignored), or sheet named range or ~ ''' Returns: ''' An object of type _Address ''' Exceptions: ''' CALCADDRESSERROR ' Address could not be parsed to a valid address Dim oAddress As Object ' Return value Dim sAddress As String ' Alias of psAddress 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 '$' If Left(psAddress, 1) = "$" Then sAddress = Mid(psAddress, 2) Else sAddress = psAddress ' Split in sheet and range components - Check presence of surrounding single quotes or dot If Left(sAddress, 1) = "'" Then lStart = 1 sSheet = ScriptForge.SF_String.FindRegex(sAddress, "^'[^\[\]*?:\/\\]+'") If lStart = 0 Then GoTo CatchAddress ' Invalid sheet name If Len(sAddress) > Len(sSheet) + 1 Then If Mid(sAddress, Len(sSheet) + 1, 1) = "." then sRange = Mid(sAddress, Len(sSheet) + 2) End If sSheet = Replace(Replace(sSheet, "$", ""), "'", "") ElseIf InStr(sAddress, ".") > 0 Then sSheet = Replace(Split(sAddress, ".")(0), "$", "") sRange = Replace(Split(sAddress, ".")(1), "$", "") Else sSheet = sAddress End If ' Resolve sheet part: either a document named range, or the active sheet or a real sheet Set oSheets = _Component.getSheets() Set oNamedRanges = _Component.NamedRanges If oSheets.hasByName(sSheet) Then ElseIf sSheet = "~" And Len(sRange) > 0 Then sSheet = _Component.CurrentController.ActiveSheet.Name ElseIf oNamedRanges.hasByName(sSheet) Then .XCellRange = oNamedRanges.getByName(sSheet).ReferredCells sSheet = oSheets.getByIndex(oNamedRanges.getByName(sSheet).ReferencePosition.Sheet).Name Else sRange = sSheet sSheet = _Component.CurrentController.ActiveSheet.Name End If .SheetName = sSheet .XSpreadSheet = oSheets.getByName(sSheet) .SheetIndex = .XSpreadSheet.RangeAddress.Sheet ' Resolve range part - either a sheet named range or the current selection or a real range or "" If IsNull(.XCellRange) Then Set oNamedRanges = .XSpreadSheet.NamedRanges If sRange = "~" Then Set oSelect = _Component.CurrentController.getSelection() If oSelect.supportsService("com.sun.star.sheet.SheetCellRanges") Then ' Multiple selections Set .XCellRange = oSelect.getByIndex(0) Else Set .XCellRange = oSelect End If ElseIf sRange = "*" Or sRange = "" Then vLastCell = _LastCell(.XSpreadSheet) sRange = "A1:" & _GetColumnName(vLastCell(0)) & CStr(vLastCell(1)) Set .XCellRange = .XSpreadSheet.getCellRangeByName(sRange) ElseIf oNamedRanges.hasByName(sRange) Then .XCellRange = oNamedRanges.getByName(sRange).ReferredCells Else On Local Error GoTo CatchError Set .XCellRange = .XSpreadSheet.getCellRangeByName(sRange) ' If range reaches the limits of the sheets, reduce it up to the used area Set oRangeAddress = .XCellRange.RangeAddress If oRangeAddress.StartColumn = 0 And oRangeAddress.EndColumn = MAXCOLS - 1 Then vLastCell = _LastCell(.XSpreadSheet) sRange = "A" & CStr(oRangeAddress.StartRow + 1) & ":" _ & _GetColumnName(vLastCell(0)) & CStr(oRangeAddress.EndRow + 1) Set .XCellRange = .XSpreadSheet.getCellRangeByName(sRange) ElseIf oRangeAddress.StartRow = 0 And oRangeAddress.EndRow = MAXROWS - 1 Then vLastCell = _LastCell(.XSpreadSheet) sRange = _GetColumnName(oRangeAddress.StartColumn + 1) & "1" & ":" _ & _GetColumnName(oRangeAddress.EndColumn + 1) & CStr(_LastCell(.XSpreadSheet)(1)) Set .XCellRange = .XSpreadSheet.getCellRangeByName(sRange) End If End If End If If IsNull(.XCellRange) Then GoTo CatchAddress Set oRangeAddress = .XCellRange.RangeAddress .RangeName = .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 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 ============================================ END OF SFDOCUMENTS.SF_CALC </script:module>
Close