| blob | fe71b69e6a82adda315c0b2dbf5ad615d2f5d9b1 |
3 <script:module xmlns:script="http://openoffice.org/2000/script" script:name="SF_Calc" script:language="StarBasic" script:moduleType="normal">REM =======================================================================================================================
4 REM === The ScriptForge library and its associated libraries are part of the LibreOffice project. ===
5 REM === The SFDocuments library is one of the associated libraries. ===
6 REM === Full documentation is available on https://help.libreoffice.org/ ===
7 REM =======================================================================================================================
9 Option Compatible
10 Option ClassModule
12 Option Explicit
14 '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
15 ''' SF_Calc
16 ''' =======
17 '''
18 ''' The SFDocuments library gathers a number of methods and properties making easy
19 ''' managing and manipulating LibreOffice documents
20 '''
21 ''' Some methods are generic for all types of documents: they are combined in the SF_Document module.
22 ''' Specific properties and methods are implemented in the concerned subclass(es) SF_Calc, SF_Base, ...
23 '''
24 ''' To workaround the absence of class inheritance in LibreOffice Basic, some redundancy is necessary
25 ''' Each subclass MUST implement also the generic methods and properties, even if they only call
26 ''' the parent methods and properties.
27 ''' They should also duplicate some generic private members as a subset of their own set of members
28 '''
29 ''' The SF_Calc module is focused on :
30 ''' - management (copy, insert, move, ...) of sheets within a Calc document
31 ''' - exchange of data between Basic data structures and Calc ranges of values
32 ''' - copying and importing massive amounts of data
33 '''
34 ''' The current module is closely related to the "UI" service of the ScriptForge library
35 '''
36 ''' Service invocation examples:
38 ''' Dim ui As Object, oDoc As Object
43 ''' Dim oDoc As Object
44 ''' Set oDoc = CreateScriptService("SFDocuments.Calc", "Untitled 1") ' Default = ActiveWindow
45 ''' ' or Set oDoc = CreateScriptService("SFDocuments.Calc", "Untitled 1") ' Untitled 1 is presumed a Calc document
47 '''
48 ''' Definitions:
49 '''
50 ''' Many methods require a "Sheet" or a "Range" as argument. (NB: a single cell is considered as a special case of a Range)
51 ''' Usually, within a specific Calc instance, sheets and ranges are given as a string: "SheetX" and "D2:F6"
52 ''' Multiple ranges are not supported in this context.
53 ''' Additionally, the .Sheet and .Range methods return a reference that may be used
54 ''' as argument of a method called from another instance of the Calc service
55 ''' Example:
56 ''' Dim oDocA As Object : Set oDocA = ui.OpenDocument("C:\FileA.ods", Hidden := True, ReadOnly := True)
58 ''' oDocB.CopyToRange(oDocA.Range("SheetX.D4:F8"), "D2:F6") ' CopyToRange(source, target)
59 '''
60 ''' Sheet: the sheet name as a string or an object produced by .Sheet()
62 ''' Range: a string designating a set of contiguous cells located in a sheet of the current instance
64 ''' or an object produced by .Range()
65 ''' The sheet name is optional (default = active sheet). Surrounding quotes and $ signs are optional
66 ''' ~.~, ~ The current selection in the active sheet
68 ''' $SheetX.D2:F6, D2:D10 Multiple cells
69 ''' $'SheetX'.A:A or 3:5 All cells in the same column or row up to the last active cell
70 ''' SheetX.* All cells up to the last active cell
71 ''' myRange A range name at spreadsheet level
72 ''' ~.yourRange, SheetX.someRange A range name at sheet level
74 ''' A range within the sheet SheetX in file associated with the myDoc Calc instance
75 '''
77 ''' A FilterFormula may be associated with a FilterScope: "row", "column" or "cell".
78 ''' These arguments determine on which rows/columns/cells of a range the method should be applied
79 ''' Examples:
80 ''' oDoc.ClearAll("A1:J10", FilterFormula := "=(A1<=0)", FilterScope := "CELL") ' Clear all negative values
81 ''' oDoc.ClearAll("SheetX.A1:J10", "=SUM(SheetX.A1:A10)>100", "COLUMN") ' Clear all columns whose sum is greater than 500
82 '''
83 ''' FilterFormula: a Calc formula that returns TRUE or FALSE
84 ''' the formula is expressed in terms of
88 ''' relative and absolute references will be interpreted correctly
89 ''' FilterScope: the way the formula is applied, once by row, by column, or by individual cell
90 '''
91 ''' Detailed user documentation:
92 ''' https://help.libreoffice.org/latest/en-US/text/sbasic/shared/03/sf_calc.html?DbPAR=BASIC
93 '''
94 '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
96 REM ================================================================== EXCEPTIONS
107 REM ============================================================= PRIVATE MEMBERS
109 Private [Me] As Object
110 Private [_Super] As Object ' Document superclass, which the current instance is a subclass of
111 Private ObjectType As String ' Must be CALC
112 Private ServiceName As String
114 ' Window component
115 Private _Component As Object ' com.sun.star.lang.XComponent
117 Type _Address
120 RawAddress As String
121 Component As Object ' com.sun.star.lang.XComponent
122 SheetName As String
123 SheetIndex As Integer
124 RangeName As String
125 Height As Long
126 Width As Long
127 XSpreadSheet As Object ' com.sun.star.sheet.XSpreadsheet
128 XCellRange As Object ' com.sun.star.table.XCellRange
129 End Type
131 Private _LastParsedAddress As Object ' _Address type - parsed ranges are cached
133 REM ============================================================ MODULE CONSTANTS
135 Private Const cstSHEET = 1
136 Private Const cstRANGE = 2
143 ' Service name of _Address (used in Python)
148 ' Presence of a special character forces surrounding the sheet name with single quotes in absolute addresses
151 REM ====================================================== CONSTRUCTOR/DESTRUCTOR
153 REM -----------------------------------------------------------------------------
154 Private Sub Class_Initialize()
155 Set [Me] = Nothing
156 Set [_Super] = Nothing
159 Set _Component = Nothing
160 Set _LastParsedAddress = Nothing
161 End Sub ' SFDocuments.SF_Calc Constructor
163 REM -----------------------------------------------------------------------------
164 Private Sub Class_Terminate()
165 Call Class_Initialize()
166 End Sub ' SFDocuments.SF_Calc Destructor
168 REM -----------------------------------------------------------------------------
169 Public Function Dispose() As Variant
170 If Not IsNull([_Super]) Then Set [_Super] = [_Super].Dispose()
171 Call Class_Terminate()
172 Set Dispose = Nothing
173 End Function ' SFDocuments.SF_Calc Explicit Destructor
175 REM ================================================================== PROPERTIES
177 REM -----------------------------------------------------------------------------
178 Property Get CurrentSelection() As Variant
179 ''' Returns as a string the currently selected range or as an array the list of the currently selected ranges
181 End Property ' SFDocuments.SF_Calc.CurrentSelection (get)
183 REM -----------------------------------------------------------------------------
184 Property Let CurrentSelection(Optional ByVal pvSelection As Variant)
185 ''' Set the selection to a single or a multiple range
186 ''' The argument is a string or an array of strings
188 Dim sRange As String ' A single selection
189 Dim oCellRanges As Object ' com.sun.star.sheet.SheetCellRanges
190 Dim vRangeAddresses As Variant ' Array of com.sun.star.table.CellRangeAddress
191 Dim i As Long
195 On Local Error GoTo Catch
197 Check:
198 If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
199 If Not _IsStillAlive(True) Then GoTo Finally
200 If IsArray(pvSelection) Then
201 If Not ScriptForge.SF_Utils._ValidateArray(pvSelection, "pvSelection", 1, V_STRING, True) Then GoTo Finally
202 Else
203 If Not ScriptForge.SF_Utils._Validate(pvSelection, "pvSelection", V_STRING) Then GoTo Finally
204 End If
205 End If
207 Try:
208 If IsArray(pvSelection) Then
210 vRangeAddresses = Array()
211 ReDim vRangeAddresses(0 To UBound(pvSelection))
212 For i = 0 To UBound(pvSelection)
213 vRangeAddresses(i) = Range(pvSelection(i)).XCellRange.RangeAddress
214 Next i
215 oCellRanges.addRangeAddresses(vRangeAddresses, False)
216 _Component.CurrentController.select(oCellRanges)
217 Else
218 _Component.CurrentController.select(_ParseAddress(pvSelection).XCellRange)
219 End If
221 Finally:
222 ScriptForge.SF_Utils._ExitFunction(cstThisSub)
223 Exit Property
224 Catch:
225 GoTo Finally
226 End Property ' SFDocuments.SF_Calc.CurrentSelection (let)
228 REM -----------------------------------------------------------------------------
229 Property Get FirstCell(Optional ByVal RangeName As Variant) As String
230 ''' Returns the First used cell in a given range or sheet
231 ''' When the argument is a sheet it will always return the "sheet.$A$1" cell
233 End Property ' SFDocuments.SF_Calc.FirstCell
235 REM -----------------------------------------------------------------------------
236 Property Get FirstColumn(Optional ByVal RangeName As Variant) As Long
237 ''' Returns the leftmost column in a given sheet or range
240 End Property ' SFDocuments.SF_Calc.FirstColumn
242 REM -----------------------------------------------------------------------------
243 Property Get FirstRow(Optional ByVal RangeName As Variant) As Long
244 ''' Returns the First used column in a given range
247 End Property ' SFDocuments.SF_Calc.FirstRow
249 REM -----------------------------------------------------------------------------
250 Property Get Height(Optional ByVal RangeName As Variant) As Long
251 ''' Returns the height in # of rows of the given range
253 End Property ' SFDocuments.SF_Calc.Height
255 REM -----------------------------------------------------------------------------
256 Property Get LastCell(Optional ByVal RangeName As Variant) As String
257 ''' Returns the last used cell in a given sheet or range
259 End Property ' SFDocuments.SF_Calc.LastCell
261 REM -----------------------------------------------------------------------------
262 Property Get LastColumn(Optional ByVal RangeName As Variant) As Long
263 ''' Returns the last used column in a given sheet
265 End Property ' SFDocuments.SF_Calc.LastColumn
267 REM -----------------------------------------------------------------------------
268 Property Get LastRow(Optional ByVal RangeName As Variant) As Long
269 ''' Returns the last used column in a given sheet
271 End Property ' SFDocuments.SF_Calc.LastRow
273 REM -----------------------------------------------------------------------------
274 Property Get Range(Optional ByVal RangeName As Variant) As Variant
275 ''' Returns a (internal) range object
277 End Property ' SFDocuments.SF_Calc.Range
279 REM -----------------------------------------------------------------------------
280 Property Get Region(Optional ByVal RangeName As Variant) As String
281 ''' Returns the smallest area as a range string that contains the given range
282 ''' and which is completely surrounded with empty cells
284 End Property ' SFDocuments.SF_Calc.Region
286 REM -----------------------------------------------------------------------------
287 Property Get Sheet(Optional ByVal SheetName As Variant) As Variant
288 ''' Returns a (internal) sheet object
290 End Property ' SFDocuments.SF_Calc.Sheet
292 REM -----------------------------------------------------------------------------
293 Property Get SheetName(Optional ByVal RangeName As Variant) As String
294 ''' Returns the sheet name part of a range
296 End Property ' SFDocuments.SF_Calc.SheetName
298 REM -----------------------------------------------------------------------------
299 Property Get Sheets() As Variant
300 ''' Returns an array listing the existing sheet names
302 End Property ' SFDocuments.SF_Calc.Sheets
304 REM -----------------------------------------------------------------------------
305 Property Get Width(Optional ByVal RangeName As Variant) As Long
306 ''' Returns the width in # of columns of the given range
308 End Property ' SFDocuments.SF_Calc.Width
310 REM -----------------------------------------------------------------------------
311 Property Get XCellRange(Optional ByVal RangeName As Variant) As Variant
312 ''' Returns a UNO object of type com.sun.star.Table.CellRange
314 End Property ' SFDocuments.SF_Calc.XCellRange
316 REM -----------------------------------------------------------------------------
317 Property Get XSheetCellCursor(Optional ByVal RangeName As Variant) As Variant
318 ''' Returns a UNO object of type com.sun.star.sheet.XSheetCellCursor
319 '' After having moved the cursor (gotoNext(), ...) the resulting range can be got
320 ''' back as a string with the cursor.AbsoluteName UNO property.
322 End Property ' SFDocuments.SF_Calc.XSheetCellCursor
324 REM -----------------------------------------------------------------------------
325 Property Get XSpreadsheet(Optional ByVal SheetName As Variant) As Variant
326 ''' Returns a UNO object of type com.sun.star.sheet.XSpreadsheet
328 End Property ' SFDocuments.SF_Calc.XSpreadsheet
330 REM ===================================================================== METHODS
332 REM -----------------------------------------------------------------------------
333 Public Function A1Style(Optional ByVal Row1 As Variant _
334 , Optional ByVal Column1 As Variant _
335 , Optional ByVal Row2 As Variant _
336 , Optional ByVal Column2 As Variant _
337 , Optional ByVal SheetName As Variant _
338 ) As String
339 ''' Returns a range expressed in A1-style as defined by its coordinates
340 ''' If only one pair of coordinates is given, the range will embrace only a single cell
341 ''' Args:
342 ''' Row1 : the row number of the first coordinate
343 ''' Column1 : the column number of the first coordinates
344 ''' Row2 : the row number of the second coordinate
345 ''' Column2 : the column number of the second coordinates
346 ''' SheetName: Default = the current sheet. If present, the sheet must exist.
347 ''' Returns:
348 ''' A range as a string
349 ''' Exceptions:
350 ''' Examples:
351 ''' range = oDoc.A1Style(5, 2, 10, 4, "SheetX") ' "'$SheetX'.$E$2:$J$4"
353 Dim sA1Style As String ' Return value
356 Dim i As Long
359 Const cstSubArgs = "Row1, Column1, [Row2], [Column2], [SheetName]="""""
361 If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
362 sA1Style = ""
364 Check:
365 If IsMissing(Row2) Or IsEmpty(Row2) Then Row2 = 0
366 If IsMissing(Column2) Or IsEmpty(Column2) Then Column2 = 0
368 vSheetName = SheetName
370 If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
371 If Not _IsStillAlive() Then GoTo Finally
372 If Not ScriptForge.SF_Utils._Validate(Row1, "Row1", ScriptForge.V_NUMERIC) Then GoTo Finally
373 If Not ScriptForge.SF_Utils._Validate(Column1, "Column1", ScriptForge.V_NUMERIC) Then GoTo Finally
374 If Not ScriptForge.SF_Utils._Validate(Row2, "Row2", ScriptForge.V_NUMERIC) Then GoTo Finally
375 If Not ScriptForge.SF_Utils._Validate(Column2, "Column2", ScriptForge.V_NUMERIC) Then GoTo Finally
376 If Not _ValidateSheet(vSheetName, "SheetName", , True, True, , , True) Then GoTo Finally
377 End If
379 If Row1 > MAXROWS Then Row1 = MAXROWS
380 If Row2 > MAXROWS Then Row2 = MAXROWS
381 If Column1 > MAXCOLS Then Column1 = MAXCOLS
382 If Column2 > MAXCOLS Then Column2 = MAXCOLS
385 lTemp = Row2 : Row2 = Row1 : Row1 = lTemp
386 End If
388 lTemp = Column2 : Column2 = Column1 : Column1 = lTemp
389 End If
391 Try:
392 ' Surround the sheet name with single quotes when required by the presence of special characters
393 vSheetName = _QuoteSheetName(vSheetName)
394 ' Define the new range string
397 & Iif(Row2 > 0 And Column2 > 0, ":$" & _GetColumnName(Column2) & "$" & CLng(Row2), "")
399 Finally:
400 A1Style = sA1Style
401 ScriptForge.SF_Utils._ExitFunction(cstThisSub)
402 Exit Function
403 Catch:
404 GoTo Finally
405 End Function ' SFDocuments.SF_Calc.A1Style
407 REM -----------------------------------------------------------------------------
408 Public Function Activate(Optional ByVal SheetName As Variant) As Boolean
409 ''' Make the current document or the given sheet active
410 ''' Args:
411 ''' SheetName: Default = the Calc document as a whole
412 ''' Returns:
413 ''' True if the document or the sheet could be made active
414 ''' Otherwise, there is no change in the actual user interface
415 ''' Examples:
418 Dim bActive As Boolean ' Return value
419 Dim oSheet As Object ' Reference to sheet
423 If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
424 bActive = False
426 Check:
427 If IsMissing(SheetName) Or IsEmpty(SheetName) Then SheetName = ""
428 If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
429 If Not _IsStillAlive() Then GoTo Finally
431 End If
433 Try:
434 ' Sheet activation, to do only when meaningful, precedes document activation
436 With _Component
437 Set oSheet = .getSheets.getByName(SheetName)
438 Set .CurrentController.ActiveSheet = oSheet
439 End With
440 End If
441 bActive = [_Super].Activate()
443 Finally:
444 Activate = bActive
445 ScriptForge.SF_Utils._ExitFunction(cstThisSub)
446 Exit Function
447 Catch:
448 GoTo Finally
449 End Function ' SFDocuments.SF_Calc.Activate
451 REM -----------------------------------------------------------------------------
452 Public Function Charts(Optional ByVal SheetName As Variant _
453 , Optional ByVal ChartName As Variant _
454 ) As Variant
455 ''' Return either the list of charts present in the given sheet or a chart object
456 ''' Args:
457 ''' SheetName: The name of an existing sheet
458 ''' ChartName: The user-defined name of the targeted chart or the zero-length string
459 ''' Returns:
460 ''' When ChartName = "", return the list of the charts present in the sheet,
461 ''' otherwise, return a new chart service instance
462 ''' Examples:
463 ''' Dim oChart As Object
466 Dim vCharts As Variant ' Return value when array of chart names
467 Dim oChart As Object ' Return value when new chart instance
468 Dim oSheet As Object ' Alias of SheetName as reference
469 Dim oDrawPage As Object ' com.sun.star.drawing.XDrawPage
470 Dim oNextShape As Object ' com.sun.star.drawing.XShape
471 Dim sChartName As String ' Some chart name
472 Dim lCount As Long ' Counter for charts among all drawing objects
473 Dim i As Long
479 If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
480 vCharts = Array()
482 Check:
483 If IsMissing(ChartName) Or IsEmpty(ChartName) Then ChartName = ""
484 If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
485 If Not _IsStillAlive(True) Then GoTo Finally
487 If Not ScriptForge.SF_Utils._Validate(ChartName, "ChartName", V_STRING) Then GoTo Finally
488 End If
490 Try:
491 ' Because the user can change it constantly, the list of valid charts has to be rebuilt at each time
492 ' Explore charts starting from the draw page
493 Set oSheet = _Component.getSheets.getByName(SheetName)
494 Set oDrawPage = oSheet.getDrawPage()
495 vCharts = Array()
496 Set oChart = Nothing
497 lCount = -1
499 Set oNextShape = oDrawPage.getByIndex(i)
500 if oNextShape.supportsService(cstChartShape) Then ' Ignore other shapes
501 sChartName = oNextShape.Name ' User-defined name
503 ' Is chart found ?
505 If ChartName = sChartName Then
506 Set oChart = New SF_Chart
507 With oChart
508 Set .[Me] = oChart
509 Set .[_Parent] = [Me]
510 ._SheetName = SheetName
511 ._DrawIndex = i
512 ._ChartName = ChartName
513 ._PersistentName = oNextShape.PersistName
514 Set ._Shape = oNextShape
515 Set ._Chart = oSheet.getCharts().getByName(._PersistentName)
516 Set ._ChartObject = ._Chart.EmbeddedObject
517 Set ._Diagram = ._ChartObject.Diagram
518 End With
519 Exit For
520 End If
521 End If
522 ' Build stack of chart names
523 lCount = lCount + 1
525 vCharts = Array(sChartName)
526 Else
528 vCharts(lCount) = sChartName
529 End If
530 End If
531 Next i
533 ' Raise error when chart not found
535 If Not ScriptForge.SF_Utils._Validate(ChartName, "ChartName", V_STRING, vCharts) Then GoTo Finally
536 End If
538 Finally:
539 If Len(ChartName) = 0 Then Charts = vCharts Else Set Charts = oChart
540 ScriptForge.SF_Utils._ExitFunction(cstThisSub)
541 Exit Function
542 Catch:
543 GoTo Finally
544 End Function ' SFDocuments.SF_Calc.Charts
546 REM -----------------------------------------------------------------------------
547 Public Sub ClearAll(Optional ByVal Range As Variant _
548 , Optional FilterFormula As Variant _
549 , Optional FilterScope As Variant _
550 )
551 ''' Clear entirely the given range
552 ''' Args:
553 ''' Range : the cell or the range as a string that should be cleared
554 ''' FilterFormula: a Calc formula to select among the given Range
555 ''' When left empty, all the cells of the range are cleared
556 ''' FilterScope: "CELL" (default value), "ROW" or "COLUMN"
557 ''' When FilterFormula is present, FilterScope is mandatory
558 ''' Examples:
560 ''' oDoc.ClearAll("A1:J20", "=($A1=0)", "ROW") ' Clears all rows when 1st cell is zero
564 End Sub ' SFDocuments.SF_Calc.ClearAll
566 REM -----------------------------------------------------------------------------
567 Public Sub ClearFormats(Optional ByVal Range As Variant _
568 , Optional FilterFormula As Variant _
569 , Optional FilterScope As Variant _
570 )
571 ''' Clear all the formatting elements of the given range
572 ''' Args:
573 ''' Range : the cell or the range as a string that should be cleared
574 ''' FilterFormula: a Calc formula to select among the given Range
575 ''' When left empty, all the cells of the range are cleared
576 ''' FilterScope: "CELL" (default value), "ROW" or "COLUMN"
577 ''' When FilterFormula is present, FilterScope is mandatory
578 ''' Examples:
579 ''' oDoc.ClearFormats("SheetX.*") ' Clears the used area of the sheet
580 ''' oDoc.ClearFormats("A1:J20", "=(MOD(A1;0)=0)", "CELL") ' Clears all even cells
584 End Sub ' SFDocuments.SF_Calc.ClearFormats
586 REM -----------------------------------------------------------------------------
587 Public Sub ClearValues(Optional ByVal Range As Variant _
588 , Optional FilterFormula As Variant _
589 , Optional FilterScope As Variant _
590 )
591 ''' Clear values and formulas in the given range
592 ''' Args:
593 ''' Range : the cell or the range as a string that should be cleared
594 ''' FilterFormula: a Calc formula to select among the given Range
595 ''' When left empty, all the cells of the range are cleared
596 ''' FilterScope: "CELL" (default value), "ROW" or "COLUMN"
597 ''' When FilterFormula is present, FilterScope is mandatory
598 ''' Examples:
599 ''' oDoc.ClearValues("SheetX.*") ' Clears the used area of the sheet
600 ''' oDoc.ClearValues("A2:A20", "=(A2=A1)", "CELL") ' Clears all duplicate cells
604 End Sub ' SFDocuments.SF_Calc.ClearValues
606 REM -----------------------------------------------------------------------------
607 Public Function CompactLeft(Optional ByVal Range As Variant _
608 , Optional ByVal WholeColumn As Variant _
609 , Optional ByVal FilterFormula As Variant _
610 ) As String
611 ''' Delete the columns of a specified range matching a filter expressed as a formula
612 ''' applied on each column.
613 ''' The deleted cells can span whole columns or be limited to the height of the range
614 ''' The execution of the method has no effect on the current selection
615 ''' Args:
616 ''' Range: the range in which cells have to be erased, as a string
617 ''' WholeColumn: when True (default = False), erase whole columns
618 ''' FilterFormula: the formula to be applied on each column.
619 ''' The column is erased when the formula results in True,
620 ''' The formula shall probably involve one or more cells of the first column of the range.
621 ''' By default, a column is erased when all the cells of the column are empty,
622 ''' i.e. suppose the range is "A1:J200" (height = 200) the default value becomes
624 ''' Returns:
625 ''' A string representing the location of the initial range after compaction,
626 ''' or the zero-length string if the whole range has been deleted
627 ''' Examples:
628 ''' newrange = oDoc.CompactLeft("SheetX.G1:L10") ' All empty columns of the range are suppressed
629 ''' newrange = oDoc.CompactLeft("SheetX.G1:L10", WholeColumn := True, FilterFormula := "=(G$7=""X"")")
632 Dim sCompact As String ' Return value
633 Dim oCompact As Object ' Return value as an _Address type
634 Dim lCountDeleted As Long ' Count the deleted columns
635 Dim vCompactRanges As Variant ' Array of ranges to be compacted based on the formula
636 Dim oSourceAddress As Object ' Alias of Range as _Address
637 Dim oPartialRange As Object ' Contiguous columns to be deleted
638 Dim sShiftRange As String ' Contiguous columns to be shifted
639 Dim i As Long
642 Const cstSubArgs = "Range, [WholeColumn=False], [FilterFormula=""""]"
644 If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
645 sCompact = ""
647 Check:
648 If IsMissing(WholeColumn) Or IsEmpty(WholeColumn) Then WholeColumn = False
649 If IsMissing(FilterFormula) Or IsEmpty(FilterFormula) Then FilterFormula = ""
650 If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
651 If Not _IsStillAlive(True) Then GoTo Finally
653 If Not ScriptForge.SF_Utils._Validate(WholeColumn, "WholeColumn", ScriptForge.V_BOOLEAN) Then GoTo Finally
654 If Not ScriptForge.SF_Utils._Validate(FilterFormula, "FilterFormula", V_STRING) Then GoTo Finally
655 End If
657 Try:
658 Set oSourceAddress = _ParseAddress(Range)
659 lCountDeleted = 0
661 With oSourceAddress
664 If FilterFormula = "" Then FilterFormula = Printf("=(COUNTBLANK(%C1%R1:%C1%R2)-" & .Height & "=0)", Range)
666 ' Identify the ranges to compact based on the given formula
669 ' Iterate through the ranges from bottom to top and shift them up
671 Set oPartialRange = vCompactRanges(i)
672 ShiftLeft(oPartialRange.RangeName, WholeColumn)
673 lCountDeleted = lCountDeleted + oPartialRange.Width
674 Next i
676 ' Compute the final range position
679 ' Push to the right the cells that migrated leftwards irrelevantly
680 If Not WholeColumn Then
681 sShiftRange = Offset(sCompact, 0, .Width - lCountDeleted, , lCountDeleted)
682 ShiftRight(sShiftRange, WholeColumn := False)
683 End If
684 ' Conventionally, if all columns are deleted, the returned range is the zero-length string
685 If .Width = lCountDeleted Then sCompact = ""
686 Else ' Initial range is left unchanged
687 sCompact = .RangeName
688 End If
690 End With
692 Finally:
693 CompactLeft = sCompact
694 ScriptForge.SF_Utils._ExitFunction(cstThisSub)
695 Exit Function
696 Catch:
697 ' When error, return the original range
698 If Not IsNull(oSourceAddress) Then sCompact = oSourceAddress.RangeName
699 GoTo Finally
700 End Function ' SFDocuments.SF_Calc.CompactLeft
702 REM -----------------------------------------------------------------------------
703 Public Function CompactUp(Optional ByVal Range As Variant _
704 , Optional ByVal WholeRow As Variant _
705 , Optional ByVal FilterFormula As Variant _
706 ) As String
707 ''' Delete the rows of a specified range matching a filter expressed as a formula
708 ''' applied on each row.
709 ''' The deleted cells can span whole rows or be limited to the width of the range
710 ''' The execution of the method has no effect on the current selection
711 ''' Args:
712 ''' Range: the range in which cells have to be erased, as a string
713 ''' WholeRow: when True (default = False), erase whole rows
714 ''' FilterFormula: the formula to be applied on each row.
715 ''' The row is erased when the formula results in True,
716 ''' The formula shall probably involve one or more cells of the first row of the range.
717 ''' By default, a row is erased when all the cells of the row are empty,
718 ''' i.e. suppose the range is "A1:J200" (width = 10) the default value becomes
720 ''' Returns:
721 ''' A string representing the location of the initial range after compaction,
722 ''' or the zero-length string if the whole range has been deleted
723 ''' Examples:
724 ''' newrange = oDoc.CompactUp("SheetX.G1:L10") ' All empty rows of the range are suppressed
725 ''' newrange = oDoc.CompactUp("SheetX.G1:L10", WholeRow := True, FilterFormula := "=(G1=""X"")")
728 Dim sCompact As String ' Return value
729 Dim lCountDeleted As Long ' Count the deleted rows
730 Dim vCompactRanges As Variant ' Array of ranges to be compacted based on the formula
731 Dim oSourceAddress As Object ' Alias of Range as _Address
732 Dim oPartialRange As Object ' Contiguous rows to be deleted
733 Dim sShiftRange As String ' Contiguous rows to be shifted
734 Dim i As Long
737 Const cstSubArgs = "Range, [WholeRow=False], [FilterFormula=""""]"
739 If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
740 sCompact = ""
742 Check:
743 If IsMissing(WholeRow) Or IsEmpty(WholeRow) Then WholeRow = False
744 If IsMissing(FilterFormula) Or IsEmpty(FilterFormula) Then FilterFormula = ""
745 If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
746 If Not _IsStillAlive(True) Then GoTo Finally
748 If Not ScriptForge.SF_Utils._Validate(WholeRow, "WholeRow", ScriptForge.V_BOOLEAN) Then GoTo Finally
749 If Not ScriptForge.SF_Utils._Validate(FilterFormula, "FilterFormula", V_STRING) Then GoTo Finally
750 End If
752 Try:
753 Set oSourceAddress = _ParseAddress(Range)
754 lCountDeleted = 0
756 With oSourceAddress
759 If FilterFormula = "" Then FilterFormula = Printf("=(COUNTBLANK(%C1%R1:%C2%R1)-" & .Width & "=0)", Range)
761 ' Identify the ranges to compact based on the given formula
764 ' Iterate through the ranges from bottom to top and shift them up
766 Set oPartialRange = vCompactRanges(i)
767 ShiftUp(oPartialRange.RangeName, WholeRow)
768 lCountDeleted = lCountDeleted + oPartialRange.Height
769 Next i
771 ' Compute the final range position
774 ' Push downwards the cells that migrated upwards irrelevantly
775 If Not WholeRow Then
776 sShiftRange = Offset(sCompact, .Height - lCountDeleted, 0, lCountDeleted)
777 ShiftDown(sShiftRange, WholeRow := False)
778 End If
779 ' Conventionally, if all rows are deleted, the returned range is the zero-length string
780 If .Height = lCountDeleted Then sCompact = ""
781 Else ' Initial range is left unchanged
782 sCompact = .RangeName
783 End If
785 End With
787 Finally:
788 CompactUp = sCompact
789 ScriptForge.SF_Utils._ExitFunction(cstThisSub)
790 Exit Function
791 Catch:
792 ' When error, return the original range
793 If Not IsNull(oSourceAddress) Then sCompact = oSourceAddress.RangeName
794 GoTo Finally
795 End Function ' SFDocuments.SF_Calc.CompactUp
797 REM -----------------------------------------------------------------------------
798 Public Function CopySheet(Optional ByVal SheetName As Variant _
799 , Optional ByVal NewName As Variant _
800 , Optional ByVal BeforeSheet As Variant _
801 ) As Boolean
802 ''' Copy a specified sheet before an existing sheet or at the end of the list of sheets
803 ''' The sheet to copy may be inside any open Calc document
804 ''' Args:
805 ''' SheetName: The name of the sheet to copy or its reference
806 ''' NewName: Must not exist
807 ''' BeforeSheet: The name (string) or index (numeric, starting from 1) of the sheet before which to insert
808 ''' Returns:
809 ''' True if the sheet could be copied successfully
810 ''' Exceptions:
811 ''' DUPLICATESHEETERROR A sheet with the given name exists already
812 ''' Examples:
814 ''' ' Copy within the same document
815 ''' Dim oDocA As Object : Set oDocA = ui.OpenDocument("C:\Temp\FileA.ods", Hidden := True, ReadOnly := True)
816 ''' Dim oDocB As Object : Set oDocB = ui.OpenDocument("C:\Temp\FileB.ods")
820 Dim bCopy As Boolean ' Return value
821 Dim oSheets As Object ' com.sun.star.sheet.XSpreadsheets
822 Dim vSheets As Variant ' List of existing sheets
823 Dim lSheetIndex As Long ' Index of a sheet
824 Dim oSheet As Object ' Alias of SheetName as reference
825 Dim lRandom As Long ' Output of random number generator
826 Dim sRandom ' Random sheet name
830 If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
831 bCopy = False
833 Check:
834 If IsMissing(BeforeSheet) Or IsEmpty(BeforeSheet) Then BeforeSheet = 32768
835 If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
836 If Not _IsStillAlive(True) Then GoTo Finally
840 End If
842 Try:
843 ' Determine the index of the sheet before which to insert the copy
844 Set oSheets = _Component.getSheets
845 vSheets = oSheets.getElementNames()
846 If VarType(BeforeSheet) = V_STRING Then
847 lSheetIndex = ScriptForge.SF_Array.IndexOf(vSheets, BeforeSheet)
848 Else
849 lSheetIndex = BeforeSheet - 1
852 End If
854 ' Copy sheet inside the same document OR import from another document
855 If VarType(SheetName) = V_STRING Then
856 _Component.getSheets.copyByName(SheetName, NewName, lSheetIndex)
857 Else
858 Set oSheet = SheetName
859 With oSheet
860 ' If a sheet with same name as input exists in the target sheet, rename it first with a random name
861 sRandom = ""
862 If ScriptForge.SF_Array.Contains(vSheets, .SheetName) Then
865 oSheets.getByName(.SheetName).setName(sRandom)
866 End If
867 ' Import i.o. Copy
868 oSheets.importSheet(oSheet.Component, .SheetName, lSheetIndex)
869 ' Rename to new sheet name
870 oSheets.getByName(.SheetName).setName(NewName)
871 ' Reset random name
873 End With
874 End If
875 bCopy = True
877 Finally:
878 CopySheet = bCopy
879 ScriptForge.SF_Utils._ExitFunction(cstThisSub)
880 Exit Function
881 Catch:
882 GoTo Finally
883 CatchDuplicate:
884 ScriptForge.SF_Exception.RaiseFatal(DUPLICATESHEETERROR, "NewName", NewName, "Document", [_Super]._FileIdent())
885 GoTo Finally
886 End Function ' SFDocuments.SF_Calc.CopySheet
888 REM -----------------------------------------------------------------------------
889 Public Function CopySheetFromFile(Optional ByVal FileName As Variant _
890 , Optional ByVal SheetName As Variant _
891 , Optional ByVal NewName As Variant _
892 , Optional ByVal BeforeSheet As Variant _
893 ) As Boolean
894 ''' Copy a specified sheet before an existing sheet or at the end of the list of sheets
895 ''' The sheet to copy is located inside any closed Calc document
896 ''' Args:
897 ''' FileName: Identifies the file to open. It must follow the SF_FileSystem.FileNaming notation
898 ''' The file must not be protected with a password
899 ''' SheetName: The name of the sheet to copy
900 ''' NewName: Must not exist
901 ''' BeforeSheet: The name (string) or index (numeric, starting from 1) of the sheet before which to insert
902 ''' Returns:
903 ''' True if the sheet could be created
904 ''' The created sheet is blank when the input file is not a Calc file
905 ''' The created sheet contains an error message when the input sheet was not found
906 ''' Exceptions:
907 ''' DUPLICATESHEETERROR A sheet with the given name exists already
908 ''' UNKNOWNFILEERROR The input file is unknown
909 ''' Examples:
910 ''' oDoc.CopySheetFromFile("C:\MyFile.ods", "SheetX", "SheetY", 3)
912 Dim bCopy As Boolean ' Return value
913 Dim oSheet As Object ' com.sun.star.sheet.XSpreadsheet
914 Dim sFileName As String ' URL alias of FileName
915 Dim FSO As Object ' SF_FileSystem
917 Const cstSubArgs = "FileName, SheetName, NewName, [BeforeSheet=""""]"
919 If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
920 bCopy = False
922 Check:
923 If IsMissing(BeforeSheet) Or IsEmpty(BeforeSheet) Then BeforeSheet = 32768
924 If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
925 If Not _IsStillAlive(True) Then GoTo Finally
927 If Not ScriptForge.SF_Utils._Validate(SheetName, "SheetName", V_STRING) Then GoTo Finally
930 End If
932 Try:
933 Set FSO = ScriptForge.SF_FileSystem
934 ' Does the input file exist ?
935 If Not FSO.FileExists(FileName) Then GoTo CatchNotExists
936 sFileName = FSO._ConvertToUrl(FileName)
938 ' Insert a blank new sheet and import sheet from file via link setting and deletion
939 If Not InsertSheet(Newname, BeforeSheet) Then GoTo Finally
940 Set oSheet = _Component.getSheets.getByName(NewName)
941 With oSheet
943 .LinkMode = com.sun.star.sheet.SheetLinkMode.NONE
944 .LinkURL = ""
945 End With
946 bCopy = True
948 Finally:
949 CopySheetFromFile = bCopy
950 ScriptForge.SF_Utils._ExitFunction(cstThisSub)
951 Exit Function
952 Catch:
953 GoTo Finally
954 CatchNotExists:
956 GoTo Finally
957 End Function ' SFDocuments.SF_Calc.CopySheetFromFile
959 REM -----------------------------------------------------------------------------
960 Public Function CopyToCell(Optional ByVal SourceRange As Variant _
961 , Optional ByVal DestinationCell As Variant _
962 ) As String
963 ''' Copy a specified source range to a destination range or cell
964 ''' The source range may belong to another open document
965 ''' The method imitates the behaviour of a Copy/Paste from a range to a single cell
966 ''' Args:
967 ''' SourceRange: the source range as a string if it belongs to the same document
968 ''' or as a reference if it belongs to another open Calc document
969 ''' DestinationCell: the destination of the copied range of cells, as a string
970 ''' If given as a range of cells, the destination will be reduced to its top-left cell
971 ''' Returns:
972 ''' A string representing the modified range of cells
973 ''' The modified area depends only on the size of the source area
974 ''' Examples:
976 ''' ' Copy within the same document
977 ''' Dim oDocA As Object : Set oDocA = ui.OpenDocument("C:\Temp\FileA.ods", Hidden := True, ReadOnly := True)
978 ''' Dim oDocB As Object : Set oDocB = ui.OpenDocument("C:\Temp\FileB.ods")
979 ''' oDocB.CopyToCell(oDocA.Range("SheetX.A1:F10"), "SheetY.C5")
982 Dim sCopy As String ' Return value
983 Dim oSource As Object ' Alias of SourceRange to avoid "Object variable not set" run-time error
984 Dim oSourceAddress As Object ' com.sun.star.table.CellRangeAddress
985 Dim oDestRange As Object ' Destination as a range
986 Dim oDestAddress As Object ' com.sun.star.table.CellRangeAddress
987 Dim oDestCell As Object ' com.sun.star.table.CellAddress
988 Dim oSelect As Object ' Current selection in source
989 Dim oClipboard As Object ' com.sun.star.datatransfer.XTransferable
994 If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
995 sCopy = ""
997 Check:
998 If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
999 If Not _IsStillAlive(True) Then GoTo Finally
1000 If Not ScriptForge.SF_Utils._Validate(SourceRange, "SourceRange", Array(V_STRING, ScriptForge.V_OBJECT), , , CALCREFERENCE) Then GoTo Finally
1001 If Not ScriptForge.SF_Utils._Validate(DestinationCell, "DestinationCell", V_STRING) Then GoTo Finally
1002 End If
1004 Try:
1005 If VarType(SourceRange) = V_STRING Then ' Same document - Use UNO copyRange method
1006 Set oSourceAddress = _ParseAddress(SourceRange).XCellRange.RangeAddress
1007 Set oDestRange = _ParseAddress(DestinationCell)
1008 Set oDestAddress = oDestRange.XCellRange.RangeAddress
1009 Set oDestCell = New com.sun.star.table.CellAddress
1010 With oDestAddress
1011 oDestCell.Sheet = .Sheet
1012 oDestCell.Column = .StartColumn
1013 oDestCell.Row = .StartRow
1014 End With
1015 oDestRange.XSpreadsheet.copyRange(oDestCell, oSourceAddress)
1016 Else ' Use clipboard to copy - current selection in Source should be preserved
1017 Set oSource = SourceRange
1018 With oSource
1019 ' Keep current selection in source document
1020 Set oSelect = .Component.CurrentController.getSelection()
1021 ' Select, copy the source range and paste in the top-left cell of the destination
1022 .Component.CurrentController.select(.XCellRange)
1023 Set oClipboard = .Component.CurrentController.getTransferable()
1025 _Component.CurrentController.insertTransferable(oClipBoard)
1026 ' Restore previous selection in Source
1027 _RestoreSelections(.Component, oSelect)
1028 Set oSourceAddress = .XCellRange.RangeAddress
1029 End With
1030 End If
1032 With oSourceAddress
1033 sCopy = _Offset(DestinationCell, 0, 0, .EndRow - .StartRow + 1, .EndColumn - .StartColumn + 1).RangeName
1034 End With
1036 Finally:
1037 CopyToCell = sCopy
1038 ScriptForge.SF_Utils._ExitFunction(cstThisSub)
1039 Exit Function
1040 Catch:
1041 GoTo Finally
1042 End Function ' SFDocuments.SF_Calc.CopyToCell
1044 REM -----------------------------------------------------------------------------
1045 Public Function CopyToRange(Optional ByVal SourceRange As Variant _
1046 , Optional ByVal DestinationRange As Variant _
1047 ) As String
1048 ''' Copy downwards and/or rightwards a specified source range to a destination range
1049 ''' The source range may belong to another open document
1050 ''' The method imitates the behaviour of a Copy/Paste from a range to a larger range
1051 ''' If the height (resp. width) of the destination area is > 1 row (resp. column)
1052 ''' then the height (resp. width) of the source must be <= the height (resp. width)
1053 ''' of the destination. Otherwise nothing happens
1055 ''' is expanded downwards (resp. rightwards) up to the height (resp. width)
1056 ''' of the source range
1057 ''' Args:
1058 ''' SourceRange: the source range as a string if it belongs to the same document
1059 ''' or as a reference if it belongs to another open Calc document
1060 ''' DestinationRange: the destination of the copied range of cells, as a string
1061 ''' Returns:
1062 ''' A string representing the modified range of cells
1063 ''' Examples:
1065 ''' ' Copy within the same document
1067 ''' Dim oDocA As Object : Set oDocA = ui.OpenDocument("C:\Temp\FileA.ods", Hidden := True, ReadOnly := True)
1068 ''' Dim oDocB As Object : Set oDocB = ui.OpenDocument("C:\Temp\FileB.ods")
1069 ''' oDocB.CopyToRange(oDocA.Range("SheetX.A1:F10"), "SheetY.C5:J5")
1072 Dim sCopy As String ' Return value
1073 Dim oSource As Object ' Alias of SourceRange to avoid "Object variable not set" run-time error
1074 Dim oDestRange As Object ' Destination as a range
1075 Dim oDestCell As Object ' com.sun.star.table.CellAddress
1076 Dim oSelect As Object ' Current selection in source
1077 Dim oClipboard As Object ' com.sun.star.datatransfer.XTransferable
1078 Dim bSameDocument As Boolean ' True when source in same document as destination
1079 Dim lHeight As Long ' Height of destination
1080 Dim lWidth As Long ' Width of destination
1085 If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
1086 sCopy = ""
1088 Check:string
1089 If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
1090 If Not _IsStillAlive(True) Then GoTo Finally
1091 If Not ScriptForge.SF_Utils._Validate(SourceRange, "SourceRange", Array(V_STRING, ScriptForge.V_OBJECT), , , CALCREFERENCE) Then GoTo Finally
1092 If Not ScriptForge.SF_Utils._Validate(DestinationRange, "DestinationRange", V_STRING) Then GoTo Finally
1093 End If
1095 Try:
1096 ' Copy done via clipboard
1099 bSameDocument = ( VarType(SourceRange) = V_STRING )
1100 If bSameDocument Then Set oSource = _ParseAddress(SourceRange) Else Set oSource = SourceRange
1101 Set oDestRange = _ParseAddress(DestinationRange)
1102 With oDestRange
1103 lHeight = .Height
1104 lWidth = .Width
1105 If lHeight = 1 Then
1106 lHeight = oSource.Height ' Future height
1107 ElseIf lHeight < oSource.Height Then
1108 GoTo Finally
1109 End If
1110 If lWidth = 1 Then
1111 lWidth = oSource.Width ' Future width
1112 ElseIf lWidth < oSource.Width Then
1113 GoTo Finally
1114 End If
1115 End With
1117 With oSource
1118 ' Store actual selection in source
1119 Set oSelect = .Component.CurrentController.getSelection()
1120 ' Select, copy the source range and paste in the destination
1121 .Component.CurrentController.select(.XCellRange)
1122 Set oClipboard = .Component.CurrentController.getTransferable()
1123 _Component.CurrentController.select(oDestRange.XCellRange)
1124 _Component.CurrentController.insertTransferable(oClipBoard)
1125 ' Restore selection in source
1126 _RestoreSelections(.Component, oSelect)
1127 End With
1131 Finally:
1132 CopyToRange = sCopy
1133 ScriptForge.SF_Utils._ExitFunction(cstThisSub)
1134 Exit Function
1135 Catch:
1136 GoTo Finally
1137 End Function ' SFDocuments.SF_Calc.CopyToRange
1139 REM -----------------------------------------------------------------------------
1140 Public Function CreateChart(Optional ByVal ChartName As Variant _
1141 , Optional ByVal SheetName As Variant _
1142 , Optional ByVal Range As Variant _
1143 , Optional ColumnHeader As Variant _
1144 , Optional RowHeader As Variant _
1145 ) As Variant
1146 ''' Return a new chart instance initialized with default values
1147 ''' Args:
1148 ''' ChartName: The user-defined name of the new chart
1149 ''' SheetName: The name of an existing sheet
1150 ''' Range: the cell or the range as a string that should be drawn
1151 ''' ColumnHeader: when True, the topmost row of the range will be used to set labels for the category axis or the legend.
1152 ''' Default = False
1153 ''' RowHeader: when True, the leftmost column of the range will be used to set labels for the category axis or the legend.
1154 ''' Default = False
1155 ''' Returns:
1156 ''' A new chart service instance
1157 ''' Exceptions:
1158 ''' DUPLICATECHARTERROR A chart with the same name exists already in the given sheet
1159 ''' Examples:
1160 ''' Dim oChart As Object
1161 ''' Set oChart = oDoc.CreateChart("myChart", "SheetX", "A1:C8", ColumnHeader := True)
1163 Dim oChart As Object ' Return value
1164 Dim vCharts As Variant ' List of pre-existing charts
1165 Dim oSheet As Object ' Alias of SheetName as reference
1166 Dim oRange As Object ' Alias of Range
1167 Dim oRectangle as new com.sun.star.awt.Rectangle ' Simple shape
1170 Const cstSubArgs = "ChartName, SheetName, Range, [ColumnHeader=False], [RowHeader=False]"
1172 If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
1173 Set oChart = Nothing
1175 Check:
1176 If IsMissing(RowHeader) Or IsEmpty(RowHeader) Then Rowheader = False
1177 If IsMissing(ColumnHeader) Or IsEmpty(ColumnHeader) Then ColumnHeader = False
1178 If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
1179 If Not _IsStillAlive(True) Then GoTo Finally
1180 If Not ScriptForge.SF_Utils._Validate(ChartName, "ChartName", V_STRING) Then GoTo Finally
1183 If Not ScriptForge.SF_Utils._Validate(ColumnHeader, "ColumnHeader", ScriptForge.V_BOOLEAN) Then GoTo Finally
1184 If Not ScriptForge.SF_Utils._Validate(RowHeader, "RowHeader", ScriptForge.V_BOOLEAN) Then GoTo Finally
1185 End If
1187 vCharts = Charts(SheetName)
1188 If ScriptForge.SF_Array.Contains(vCharts, ChartName, CaseSensitive := True) Then GoTo CatchDuplicate
1190 Try:
1191 ' The rectangular shape receives arbitrary values. User can Resize() it later
1192 With oRectangle
1195 End With
1196 ' Initialize sheet and range
1197 Set oSheet = _Component.getSheets.getByName(SheetName)
1198 Set oRange = _ParseAddress(Range)
1199 ' Create the chart and get ihe corresponding chart instance
1200 oSheet.getCharts.addNewByName(ChartName, oRectangle, Array(oRange.XCellRange.RangeAddress), ColumnHeader, RowHeader)
1201 Set oChart = Charts(SheetName, ChartName)
1202 oChart._Shape.Name = ChartName ' Both user-defined and internal names match ChartName
1203 oChart._Diagram.Wall.FillColor = RGB(255, 255, 255) ' Align on background color set by the user interface by default
1205 Finally:
1206 Set CreateChart = oChart
1207 ScriptForge.SF_Utils._ExitFunction(cstThisSub)
1208 Exit Function
1209 Catch:
1210 GoTo Finally
1211 CatchDuplicate:
1212 ScriptForge.SF_Exception.RaiseFatal(DUPLICATECHARTERROR, "ChartName", ChartName, "SheetName", SheetName, "Document", [_Super]._FileIdent())
1213 GoTo Finally
1214 End Function ' SFDocuments.SF_Calc.CreateChart
1216 REM -----------------------------------------------------------------------------
1217 Public Function CreatePivotTable(Optional ByVal PivotTableName As Variant _
1218 , Optional ByVal SourceRange As Variant _
1219 , Optional ByVal TargetCell As Variant _
1220 , Optional ByRef DataFields As Variant _
1221 , Optional ByRef RowFields As Variant _
1222 , Optional ByRef ColumnFields As Variant _
1223 , Optional ByVal FilterButton As Variant _
1224 , Optional ByVal RowTotals As Variant _
1225 , Optional ByVal ColumnTotals As Variant _
1226 ) As String
1227 ''' Create a new pivot table with the properties defined by the arguments.
1228 ''' If a pivot table with the same name exists already in the targeted sheet, it will be erased without warning.
1229 ''' Args:
1230 ''' PivotTableName: The user-defined name of the new pivottable
1231 ''' SourceRange: The range as a string containing the raw data.
1232 ''' The first row of the range is presumed to contain the field names of the new pivot table
1233 ''' TargetCell: the top left cell or the range as a string where to locate the pivot table.
1234 ''' Only the top left cell of the range will be considered.
1235 ''' DataFields: A single string or an array of field name + function to apply, formatted like:
1237 ''' The allowed functions are: Sum, Count, Average, Max, Min, Product, CountNums, StDev, StDevP, Var, VarP and Median.
1238 ''' The default function is: When the values are all numerical, Sum is used, otherwise Count
1239 ''' RowFields: A single string or an array of the field names heading the pivot table rows
1240 ''' ColumnFields: A single string or an array of the field names heading the pivot table columns
1241 ''' FilterButton: When True (default), display a "Filter" button above the pivot table
1242 ''' RowTotals: When True (default), display a separate column for row totals
1243 ''' ColumnTotals: When True (default), display a separate row for column totals
1244 ''' Returns:
1245 ''' Return the range where the new pivot table is deployed.
1246 ''' Examples:
1247 ''' Dim vData As Variant, oDoc As Object, sTable As String, sPivot As String
1248 ''' vData = Array(Array("Item", "State", "Team", "2002", "2003", "2004"), _
1249 ''' Array("Books", "Michigan", "Jean", 14788, 30222, 23490), _
1250 ''' Array("Candy", "Michigan", "Jean", 26388, 15641, 32849), _
1251 ''' Array("Pens", "Michigan", "Jean", 16569, 32675, 25396), _
1252 ''' Array("Books", "Michigan", "Volker", 21961, 21242, 29009), _
1253 ''' Array("Candy", "Michigan", "Volker", 26142, 22407, 32841))
1256 ''' sPivot = oDoc.CreatePivotTable("PT1", sTable, "H1", Array("2002", "2003;count", "2004;average"), "Item", Array("State", "Team"), False)
1258 Dim sPivotTable As String ' Return value
1259 Dim vData As Variant ' Alias of DataFields
1260 Dim vRows As Variant ' Alias of RowFields
1261 Dim vColumns As Variant ' Alias of ColumnFields
1262 Dim oSourceAddress As Object ' Source as an _Address
1263 Dim oTargetAddress As Object ' Target as an _Address
1264 Dim vHeaders As Variant ' Array of header fields in the source range
1265 Dim oPivotTables As Object ' com.sun.star.sheet.XDataPilotTables
1266 Dim oDescriptor As Object ' com.sun.star.sheet.DataPilotDescriptor
1267 Dim oFields As Object ' ScDataPilotFieldsObj - Collection of fields
1268 Dim oField As Object ' ScDataPilotFieldsObj - A single field
1269 Dim sField As String ' A single field name
1270 Dim sData As String ' A single data field name + function
1271 Dim vDataField As Variant ' A single vData element, split on semicolon
1272 Dim sFunction As String ' Function to apply on a data field (string)
1273 Dim iFunction As Integer ' Equivalent of sFunction as com.sun.star.sheet.GeneralFunction2 constant
1274 Dim oOutputRange As Object ' com.sun.star.table.CellRangeAddress
1275 Dim i As Integer
1278 Const cstSubArgs = "PivotTableName, SourceRange, TargetCell, DataFields, [RowFields], [ColumnFields]" _
1281 If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
1282 sPivotTable = ""
1284 Check:
1285 If IsMissing(RowFields) Or IsEmpty(RowFields) Then RowFields = Array()
1286 If IsMissing(ColumnFields) Or IsEmpty(ColumnFields) Then ColumnFields = Array()
1287 If IsMissing(FilterButton) Or IsEmpty(FilterButton) Then FilterButton = True
1288 If IsMissing(RowTotals) Or IsEmpty(RowTotals) Then RowTotals = True
1289 If IsMissing(ColumnTotals) Or IsEmpty(ColumnTotals) Then ColumnTotals = True
1290 If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
1291 If Not _IsStillAlive(True) Then GoTo Finally
1292 If Not ScriptForge.SF_Utils._Validate(PivotTableName, "PivotTableName", V_STRING) Then GoTo Finally
1293 If Not ScriptForge.SF_Utils._Validate(SourceRange, "SourceRange", V_STRING) Then GoTo Finally
1294 If Not ScriptForge.SF_Utils._Validate(TargetCell, "TargetCell", V_STRING) Then GoTo Finally
1295 If IsArray(DataFields) Then
1296 If Not ScriptForge.SF_Utils._ValidateArray(DataFields, "DataFields", 1, V_STRING, True) Then GoTo Finally
1297 Else
1298 If Not ScriptForge.SF_Utils._Validate(DataFields, "DataFields", V_STRING) Then GoTo Finally
1299 End If
1300 If IsArray(RowFields) Then
1301 If Not ScriptForge.SF_Utils._ValidateArray(RowFields, "RowFields", 1, V_STRING, True) Then GoTo Finally
1302 Else
1303 If Not ScriptForge.SF_Utils._Validate(RowFields, "RowFields", V_STRING) Then GoTo Finally
1304 End If
1305 If IsArray(ColumnFields) Then
1306 If Not ScriptForge.SF_Utils._ValidateArray(ColumnFields, "ColumnFields", 1, V_STRING, True) Then GoTo Finally
1307 Else
1308 If Not ScriptForge.SF_Utils._Validate(ColumnFields, "ColumnFields", V_STRING) Then GoTo Finally
1309 End If
1310 If Not ScriptForge.SF_Utils._Validate(FilterButton, "FilterButton", ScriptForge.V_BOOLEAN) Then GoTo Finally
1311 If Not ScriptForge.SF_Utils._Validate(RowTotals, "RowTotals", ScriptForge.V_BOOLEAN) Then GoTo Finally
1312 If Not ScriptForge.SF_Utils._Validate(ColumnTotals, "ColumnTotals", ScriptForge.V_BOOLEAN) Then GoTo Finally
1313 End If
1314 ' Next statements must be outside previous If-block to force their execution even in case of internal call
1315 If IsArray(DataFields) Then vData = DataFields Else vData = Array(DataFields)
1316 If IsArray(RowFields) Then vRows = RowFields Else vRows = Array(RowFields)
1317 If IsArray(ColumnFields) Then vColumns = ColumnFields Else vColumns = Array(ColumnFields)
1319 Try:
1321 Set oSourceAddress = _ParseAddress(SourceRange)
1322 vHeaders = GetValue(Offset(SourceRange, 0, 0, 1)) ' Content of the first row of the source
1324 Set oPivotTables = oTargetAddress.XSpreadsheet.getDataPilotTables()
1326 ' Initialize new pivot table
1327 Set oDescriptor = oPivotTables.createDataPilotDescriptor()
1328 oDescriptor.setSourceRange(oSourceAddress.XCellRange.RangeAddress)
1329 Set oFields = oDescriptor.getDataPilotFields()
1331 ' Set row fields
1332 For i = 0 To UBound(vRows)
1333 sField = vRows(i)
1335 If Not ScriptForge.SF_Utils._Validate(sField, "RowFields", V_STRING, vHeaders) Then GoTo Finally
1336 Set oField = oFields.getByName(sField)
1337 oField.Orientation = com.sun.star.sheet.DataPilotFieldOrientation.ROW
1338 End If
1339 Next i
1341 ' Set column fields
1342 For i = 0 To UBound(vColumns)
1343 sField = vColumns(i)
1345 If Not ScriptForge.SF_Utils._Validate(sField, "ColumnFields", V_STRING, vHeaders) Then GoTo Finally
1346 Set oField = oFields.getByName(sField)
1347 oField.Orientation = com.sun.star.sheet.DataPilotFieldOrientation.COLUMN
1348 End If
1349 Next i
1351 ' Set data fields
1352 For i = 0 To UBound(vData)
1353 sData = vData(i)
1354 ' Minimal parsing
1357 sField = vDataField(0)
1359 ' Define field properties
1361 If Not ScriptForge.SF_Utils._Validate(sField, "DataFields", V_STRING, vHeaders) Then GoTo Finally
1362 Set oField = oFields.getByName(sField)
1363 oField.Orientation = com.sun.star.sheet.DataPilotFieldOrientation.DATA
1364 ' Associate the correct function
1365 With com.sun.star.sheet.GeneralFunction2
1366 Select Case UCase(sFunction)
1367 Case "" : iFunction = .AUTO
1380 Case Else
1382 , Array("Sum", "Count", "Average", "Max", "Min", "Product", "CountNums" _
1383 , "StDev", "StDevP", "Var", "VarP", "Median") _
1384 ) Then GoTo Finally
1385 End Select
1386 End With
1387 oField.Function2 = iFunction
1388 End If
1389 Next i
1391 ' Remove any pivot table with same name
1392 If oPivotTables.hasByName(PivotTableName) Then oPivotTables.removeByName(PivotTableName)
1394 ' Finalize the new pivot table
1395 oDescriptor.ShowFilterButton = FilterButton
1396 oDescriptor.RowGrand = RowTotals
1397 oDescriptor.ColumnGrand = ColumnTotals
1398 oPivotTables.insertNewByName(PivotTableName, oTargetAddress.XCellRange.getCellByPosition(0, 0).CellAddress, oDescriptor)
1400 ' Determine the range of the new pivot table
1401 Set oOutputRange = oPivotTables.getByName(PivotTableName).OutputRange
1402 With oOutputRange
1403 sPivotTable = _Component.getSheets().getCellRangeByPosition(.StartColumn, .StartRow, .EndColumn, .EndRow, .Sheet).AbsoluteName
1404 End With
1406 Finally:
1407 CreatePivotTable = sPivotTable
1408 ScriptForge.SF_Utils._ExitFunction(cstThisSub)
1409 Exit Function
1410 Catch:
1411 GoTo Finally
1412 End Function ' SFDocuments.SF_Calc.CreatePivotTable
1414 REM -----------------------------------------------------------------------------
1415 Public Function DAvg(Optional ByVal Range As Variant) As Double
1416 ''' Get the average of the numeric values stored in the given range
1417 ''' Args:
1418 ''' Range : the range as a string where to get the values from
1419 ''' Returns:
1420 ''' The average of the numeric values as a double
1421 ''' Examples:
1424 Try:
1427 Finally:
1428 Exit Function
1429 End Function ' SFDocuments.SF_Calc.DAvg
1431 REM -----------------------------------------------------------------------------
1432 Public Function DCount(Optional ByVal Range As Variant) As Long
1433 ''' Get the number of numeric values stored in the given range
1434 ''' Args:
1435 ''' Range : the range as a string where to get the values from
1436 ''' Returns:
1437 ''' The number of numeric values as a Long
1438 ''' Examples:
1441 Try:
1444 Finally:
1445 Exit Function
1446 End Function ' SFDocuments.SF_Calc.DCount
1448 REM -----------------------------------------------------------------------------
1449 Public Function DMax(Optional ByVal Range As Variant) As Double
1450 ''' Get the greatest of the numeric values stored in the given range
1451 ''' Args:
1452 ''' Range : the range as a string where to get the values from
1453 ''' Returns:
1454 ''' The greatest of the numeric values as a double
1455 ''' Examples:
1458 Try:
1461 Finally:
1462 Exit Function
1463 End Function ' SFDocuments.SF_Calc.DMax
1465 REM -----------------------------------------------------------------------------
1466 Public Function DMin(Optional ByVal Range As Variant) As Double
1467 ''' Get the smallest of the numeric values stored in the given range
1468 ''' Args:
1469 ''' Range : the range as a string where to get the values from
1470 ''' Returns:
1471 ''' The smallest of the numeric values as a double
1472 ''' Examples:
1475 Try:
1478 Finally:
1479 Exit Function
1480 End Function ' SFDocuments.SF_Calc.DMin
1482 REM -----------------------------------------------------------------------------
1483 Public Function DSum(Optional ByVal Range As Variant) As Double
1484 ''' Get sum of the numeric values stored in the given range
1485 ''' Args:
1486 ''' Range : the range as a string where to get the values from
1487 ''' Returns:
1488 ''' The sum of the numeric values as a double
1489 ''' Examples:
1492 Try:
1495 Finally:
1496 Exit Function
1497 End Function ' SFDocuments.SF_Calc.DSum
1499 REM -----------------------------------------------------------------------------
1500 Public Function ExportRangeToFile(Optional ByVal Range As Variant _
1501 , Optional ByVal FileName As Variant _
1502 , Optional ByVal ImageType As Variant _
1503 , Optional ByVal Overwrite As Variant _
1504 ) As Boolean
1505 ''' Store the given range as an image to the given file location
1506 ''' Actual selections are not impacted
1507 ''' Inspired by https://stackoverflow.com/questions/30509532/how-to-export-cell-range-to-pdf-file
1508 ''' Args:
1509 ''' Range: sheet name or cell range to be exported, as a string
1510 ''' FileName: Identifies the file where to save. It must follow the SF_FileSystem.FileNaming notation
1511 ''' ImageType: the name of the targeted media type
1512 ''' Allowed values: jpeg, pdf (default) and png
1513 ''' Overwrite: True if the destination file may be overwritten (default = False)
1514 ''' Returns:
1515 ''' False if the document could not be saved
1516 ''' Exceptions:
1517 ''' RANGEEXPORTERROR The destination has its readonly attribute set or overwriting rejected
1518 ''' Examples:
1519 ''' oDoc.ExportRangeToFile('SheetX.B2:J15", "C:\Me\Range2.png", ImageType := "png", Overwrite := True)
1521 Dim bSaved As Boolean ' return value
1522 Dim oSfa As Object ' com.sun.star.ucb.SimpleFileAccess
1523 Dim sFile As String ' Alias of FileName
1524 Dim vStoreArguments As Variant ' Array of com.sun.star.beans.PropertyValue
1525 Dim vFilterData As Variant ' Array of com.sun.star.beans.PropertyValue
1526 Dim FSO As Object ' SF_FileSystem
1527 Dim vImageTypes As Variant ' Array of permitted image types
1528 Dim vFilters As Variant ' Array of corresponding filters in the same order as vImageTypes
1529 Dim sFilter As String ' The filter to apply
1530 Dim oSelect As Object ' Currently selected range(s)
1531 Dim oAddress As Object ' Alias of Range
1537 Const cstSubArgs = "Range, FileName, [ImageType=""pdf""|""jpeg""|""png""], [Overwrite=False]"
1539 If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo CatchError
1540 bSaved = False
1542 Check:
1544 If IsMissing(Overwrite) Or IsEmpty(Overwrite) Then Overwrite = False
1547 If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
1548 If Not _IsStillAlive() Then GoTo Finally
1551 If Not ScriptForge.SF_Utils._Validate(ImageType, "ImageType", V_STRING, vImageTypes) Then GoTo Finally
1552 If Not ScriptForge.SF_Utils._Validate(Overwrite, "Overwrite", ScriptForge.V_BOOLEAN) Then GoTo Finally
1553 End If
1555 ' Check destination file overwriting
1557 sFile = FSO._ConvertToUrl(FileName)
1558 If FSO.FileExists(FileName) Then
1559 If Overwrite = False Then GoTo CatchError
1561 If oSfa.isReadonly(sFile) Then GoTo CatchError
1562 End If
1564 Try:
1565 ' Setup arguments
1567 sFilter = vFilters(ScriptForge.SF_Array.IndexOf(vImageTypes, ImageType, CaseSensitive := False))
1568 Set oAddress = _ParseAddress(Range)
1570 ' The filter arguments differ between
1574 vFilterData = Array(ScriptForge.SF_Utils._MakePropertyValue("Selection", oAddress.XCellRange) )
1575 vStoreArguments = Array( _
1578 )
1579 Else ' png, jpeg
1580 ' Save the current selection(s)
1581 Set oSelect = _Component.CurrentController.getSelection()
1582 _Component.CurrentController.select(oAddress.XCellRange)
1583 vStoreArguments = Array( _
1586 )
1587 End If
1589 ' Apply the filter and export
1590 _Component.storeToUrl(sFile, vStoreArguments)
1593 bSaved = True
1595 Finally:
1596 ExportRangeToFile = bSaved
1597 ScriptForge.SF_Utils._ExitFunction(cstThisSub)
1598 Exit Function
1599 Catch:
1600 GoTo Finally
1601 CatchError:
1602 ScriptForge.SF_Exception.RaiseFatal(RANGEEXPORTERROR, "FileName", FileName, "Overwrite", Overwrite)
1603 GoTo Finally
1604 End Function ' SFDocuments.SF_Chart.ExportRangeToFile
1606 REM -----------------------------------------------------------------------------
1607 Public Function Forms(Optional ByVal SheetName As Variant _
1608 , Optional ByVal Form As Variant _
1609 ) As Variant
1610 ''' Return either
1611 ''' - the list of the Forms contained in the given sheet
1612 ''' - a SFDocuments.Form object based on its name or its index
1613 ''' Args:
1614 ''' SheetName: the name of the sheet containing the requested form or forms
1615 ''' Form: a form stored in the document given by its name or its index
1616 ''' When absent, the list of available forms is returned
1618 ''' Exceptions:
1619 ''' CALCFORMNOTFOUNDERROR Form not found
1620 ''' Returns:
1621 ''' A zero-based array of strings if Form is absent
1622 ''' An instance of the SF_Form class if Form exists
1623 ''' Example:
1624 ''' Dim myForm As Object, myList As Variant
1628 Dim oForm As Object ' The new Form class instance
1629 Dim oMainForm As Object ' com.sun.star.comp.sdb.Content
1630 Dim oXForm As Object ' com.sun.star.form.XForm or com.sun.star.comp.forms.ODatabaseForm
1631 Dim vFormNames As Variant ' Array of form names
1632 Dim oForms As Object ' Forms collection
1638 If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
1640 Check:
1641 If IsMissing(Form) Or IsEmpty(Form) Then Form = ""
1642 If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
1643 If Not _IsStillAlive() Then GoTo Finally
1645 If Not ScriptForge.SF_Utils._Validate(Form, "Form", Array(V_STRING, ScriptForge.V_NUMERIC)) Then GoTo Finally
1646 End If
1648 Try:
1649 ' Start from the Calc sheet and go down to forms
1650 Set oForms = _Component.getSheets.getByName(SheetName).DrawPage.Forms
1651 vFormNames = oForms.getElementNames()
1654 Forms = vFormNames
1655 Else
1656 If VarType(Form) = V_STRING Then ' Find the form by name
1657 If Not ScriptForge.SF_Utils._Validate(Form, "Form", V_STRING, vFormNames) Then GoTo Finally
1658 Set oXForm = oForms.getByName(Form)
1659 Else ' Find the form by index
1661 Set oXForm = oForms.getByIndex(Form)
1662 End If
1663 ' Create the new Form class instance
1664 Set oForm = SF_Register._NewForm(oXForm)
1665 With oForm
1666 Set .[_Parent] = [Me]
1667 ._SheetName = SheetName
1668 ._FormType = ISCALCFORM
1669 Set ._Component = _Component
1670 ._Initialize()
1671 End With
1672 Set Forms = oForm
1673 End If
1675 Finally:
1676 ScriptForge.SF_Utils._ExitFunction(cstThisSub)
1677 Exit Function
1678 Catch:
1679 GoTo Finally
1680 CatchNotFound:
1681 ScriptForge.SF_Exception.RaiseFatal(CALCFORMNOTFOUNDERROR, Form, _FileIdent())
1682 End Function ' SFDocuments.SF_Calc.Forms
1684 REM -----------------------------------------------------------------------------
1685 Function GetColumnName(Optional ByVal ColumnNumber As Variant) As String
1686 ''' Convert a column number (range 1, 2,..1024) into its letter counterpart (range 'A', 'B',..'AMJ').
1687 ''' Args:
1689 ''' Returns:
1690 ''' a string representation of the column name, in range 'A'..'AMJ'
1691 ''' If ColumnNumber is not in the allowed range, returns a zero-length string
1692 ''' Example:
1694 ''' Adapted from a Python function by sundar nataraj
1695 ''' http://stackoverflow.com/questions/23861680/convert-spreadsheet-number-to-column-letter
1697 Dim sCol As String ' Return value
1701 If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
1702 sCol = ""
1704 Check:
1705 If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
1707 End If
1709 Try:
1710 If (ColumnNumber > 0) And (ColumnNumber <= MAXCOLS) Then sCol = _GetColumnName(ColumnNumber)
1712 Finally:
1713 GetColumnName = sCol
1714 ScriptForge.SF_Utils._ExitFunction(cstThisSub)
1715 Exit Function
1716 Catch:
1717 GoTo Finally
1718 End Function ' SFDocuments.SF_Calc.GetColumnName
1720 REM -----------------------------------------------------------------------------
1721 Public Function GetFormula(Optional ByVal Range As Variant) As Variant
1722 ''' Get the formula(e) stored in the given range of cells
1723 ''' Args:
1724 ''' Range : the range as a string where to get the formula from
1725 ''' Returns:
1727 ''' Examples:
1730 Dim vGet As Variant ' Return value
1731 Dim oAddress As Object ' Alias of Range
1732 Dim vDataArray As Variant ' DataArray compatible with .DataArray UNO property
1736 If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
1737 vGet = Empty
1739 Check:
1740 If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
1741 If Not _IsStillAlive() Then GoTo Finally
1743 End If
1745 Try:
1746 ' Get the data
1747 Set oAddress = _ParseAddress(Range)
1748 vDataArray = oAddress.XCellRange.getFormulaArray()
1750 ' Convert the data array to scalar, vector or array
1751 vGet = _ConvertFromDataArray(vDataArray)
1753 Finally:
1754 GetFormula = vGet
1755 ScriptForge.SF_Utils._ExitFunction(cstThisSub)
1756 Exit Function
1757 Catch:
1758 GoTo Finally
1759 End Function ' SFDocuments.SF_Calc.GetFormula
1761 REM -----------------------------------------------------------------------------
1762 Public Function GetProperty(Optional ByVal PropertyName As Variant _
1763 , Optional ObjectName As Variant _
1764 ) As Variant
1765 ''' Return the actual value of the given property
1766 ''' Args:
1767 ''' PropertyName: the name of the property as a string
1768 ''' ObjectName: a sheet or range name
1769 ''' Returns:
1770 ''' The actual value of the property
1771 ''' Exceptions:
1772 ''' ARGUMENTERROR The property does not exist
1775 Const cstSubArgs = ""
1777 If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
1778 GetProperty = Null
1780 Check:
1781 If IsMissing(ObjectName) Or IsEMpty(ObjectName) Then ObjectName = ""
1782 If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
1783 If Not ScriptForge.SF_Utils._Validate(PropertyName, "PropertyName", V_STRING, Properties()) Then GoTo Catch
1784 If Not ScriptForge.SF_Utils._Validate(ObjectName, "ObjectName", V_STRING) Then GoTo Catch
1785 End If
1787 Try:
1788 ' Superclass or subclass property ?
1789 If ScriptForge.SF_Array.Contains([_Super].Properties(), PropertyName) Then
1790 GetProperty = [_Super].GetProperty(PropertyName)
1791 ElseIf Len(ObjectName) = 0 Then
1792 GetProperty = _PropertyGet(PropertyName)
1793 Else
1794 GetProperty = _PropertyGet(PropertyName, ObjectName)
1795 End If
1797 Finally:
1798 ScriptForge.SF_Utils._ExitFunction(cstThisSub)
1799 Exit Function
1800 Catch:
1801 GoTo Finally
1802 End Function ' SFDocuments.SF_Calc.GetProperty
1804 REM -----------------------------------------------------------------------------
1805 Public Function GetValue(Optional ByVal Range As Variant) As Variant
1806 ''' Get the value(s) stored in the given range of cells
1807 ''' Args:
1808 ''' Range : the range as a string where to get the value from
1809 ''' Returns:
1810 ''' A scalar, a zero-based 1D array or a zero-based 2D array of strings and doubles
1811 ''' To convert doubles to dates, use the CDate builtin function
1812 ''' Examples:
1815 Dim vGet As Variant ' Return value
1816 Dim oAddress As Object ' Alias of Range
1817 Dim vDataArray As Variant ' DataArray compatible with .DataArray UNO property
1821 If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
1822 vGet = Empty
1824 Check:
1825 If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
1826 If Not _IsStillAlive() Then GoTo Finally
1828 End If
1830 Try:
1831 ' Get the data
1832 Set oAddress = _ParseAddress(Range)
1833 vDataArray = oAddress.XCellRange.getDataArray()
1835 ' Convert the data array to scalar, vector or array
1836 vGet = _ConvertFromDataArray(vDataArray)
1838 Finally:
1839 GetValue = vGet
1840 ScriptForge.SF_Utils._ExitFunction(cstThisSub)
1841 Exit Function
1842 Catch:
1843 GoTo Finally
1844 End Function ' SFDocuments.SF_Calc.GetValue
1846 REM -----------------------------------------------------------------------------
1847 Public Function ImportFromCSVFile(Optional ByVal FileName As Variant _
1848 , Optional ByVal DestinationCell As Variant _
1849 , Optional ByVal FilterOptions As Variant _
1850 ) As String
1851 ''' Import the content of a CSV-formatted text file starting from a given cell
1852 ''' Beforehand the destination area will be cleared from any content and format
1853 ''' Args:
1854 ''' FileName: Identifies the file to open. It must follow the SF_FileSystem.FileNaming notation
1855 ''' DestinationCell: the destination of the copied range of cells, as a string
1856 ''' If given as range, the destination will be reduced to its top-left cell
1857 ''' FilterOptions: The arguments of the CSV input filter.
1858 ''' Read https://wiki.documentfoundation.org/Documentation/DevGuide/Spreadsheet_Documents#Filter_Options_for_the_CSV_Filter
1859 ''' Default: input file encoding is UTF8
1860 ''' separator = comma, semi-colon or tabulation
1861 ''' string delimiter = double quote
1862 ''' all lines are included
1863 ''' quoted strings are formatted as texts
1864 ''' special numbers are detected
1865 ''' all columns are presumed texts
1866 ''' language = english/US => decimal separator is ".", thousands separator = ","
1867 ''' Returns:
1868 ''' A string representing the modified range of cells
1869 ''' The modified area depends only on the content of the source file
1870 ''' Exceptions:
1871 ''' DOCUMENTOPENERROR The csv file could not be opened
1872 ''' Examples:
1873 ''' oDoc.ImportFromCSVFile("C:\Temp\myCsvFile.csv", "SheetY.C5")
1875 Dim sImport As String ' Return value
1876 Dim oUI As Object ' UI service
1877 Dim oSource As Object ' New Calc document with csv loaded
1878 Dim oSelect As Object ' Current selection in destination
1883 Const cstSubArgs = "FileName, DestinationCell, [FilterOptions]=""9/44/59/MRG,34,76,1,,1033,true,true"""
1885 ' If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
1886 sImport = ""
1888 Check:
1889 If IsMissing(FilterOptions) Or IsEmpty(FilterOptions) Then FilterOptions = cstFilterOptions
1890 If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
1891 If Not _IsStillAlive(True) Then GoTo Finally
1893 If Not ScriptForge.SF_Utils._Validate(DestinationCell, "DestinationCell", V_STRING) Then GoTo Finally
1894 End If
1896 Try:
1897 ' Input file is loaded in an empty worksheet. Data are copied to destination cell
1899 Set oSource = oUI.OpenDocument(FileName _
1900 , ReadOnly := True _
1901 , Hidden := True _
1902 , FilterName := cstFilter _
1903 , FilterOptions := FilterOptions _
1904 )
1905 ' Remember current selection and restore it after copy
1906 Set oSelect = _Component.CurrentController.getSelection()
1908 _RestoreSelections(_Component, oSelect)
1910 Finally:
1911 If Not IsNull(oSource) Then oSource.CloseDocument(False)
1912 ImportFromCSVFile = sImport
1913 ScriptForge.SF_Utils._ExitFunction(cstThisSub)
1914 Exit Function
1915 Catch:
1916 GoTo Finally
1917 End Function ' SFDocuments.SF_Calc.ImportFromCSVFile
1919 REM -----------------------------------------------------------------------------
1920 Public Sub ImportFromDatabase(Optional ByVal FileName As Variant _
1921 , Optional ByVal RegistrationName As Variant _
1922 , Optional ByVal DestinationCell As Variant _
1923 , Optional ByVal SQLCommand As Variant _
1924 , Optional ByVal DirectSQL As Variant _
1925 )
1926 ''' Import the content of a database table, query or resultset, i.e. the result of a SELECT SQL command,
1927 ''' starting from a given cell
1928 ''' Beforehand the destination area will be cleared from any content and format
1929 ''' The modified area depends only on the content of the source data
1930 ''' Args:
1931 ''' FileName: Identifies the file to open. It must follow the SF_FileSystem.FileNaming notation
1932 ''' RegistrationName: the name of a registered database
1934 ''' DestinationCell: the destination of the copied range of cells, as a string
1935 ''' If given as a range of cells, the destination will be reduced to its top-left cell
1936 ''' SQLCommand: either a table or query name (without square brackets)
1937 ''' or a full SQL commands where table and fieldnames are preferably surrounded with square brackets
1938 ''' Returns:
1939 ''' Implemented as a Sub because the doImport UNO method does not return any error
1940 ''' Exceptions:
1941 ''' BASEDOCUMENTOPENERROR The database file could not be opened
1942 ''' Examples:
1943 ''' oDoc.ImportFromDatabase("C:\Temp\myDbFile.odb", , "SheetY.C5", "SELECT * FROM [Employees] ORDER BY [LastName]")
1945 Dim oDBContext As Object ' com.sun.star.sdb.DatabaseContext
1946 Dim oDatabase As Object ' SFDatabases.Database service
1947 Dim lCommandType As Long ' A com.sun.star.sheet.DataImportMode.xxx constant
1948 Dim oQuery As Object ' com.sun.star.ucb.XContent
1949 Dim bDirect As Boolean ' Alias of DirectSQL
1950 Dim oDestRange As Object ' Destination as a range
1951 Dim oDestAddress As Object ' com.sun.star.table.CellRangeAddress
1952 Dim oDestCell As Object ' com.sun.star.table.XCell
1953 Dim oSelect As Object ' Current selection in destination
1954 Dim vImportOptions As Variant ' Array of PropertyValues
1957 Const cstSubArgs = "[FileName=""""], [RegistrationName=""""], DestinationCell, SQLCommand, [DirectSQL=False]"
1959 ' If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
1961 Check:
1963 If IsMissing(FileName) Or IsEmpty(FileName) Then FileName = ""
1964 If IsMissing(RegistrationName) Or IsEmpty(RegistrationName) Then RegistrationName = ""
1965 If IsMissing(DirectSQL) Or IsEmpty(DirectSQL) Then DirectSQL = False
1966 If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
1967 If Not _IsStillAlive(True) Then GoTo Finally
1968 If Not ScriptForge.SF_Utils._ValidateFile(FileName, "FileName", , True) Then GoTo Finally
1969 If Not ScriptForge.SF_Utils._Validate(DestinationCell, "DestinationCell", V_STRING) Then GoTo Finally
1970 If Not ScriptForge.SF_Utils._Validate(SQLCommand, "SQLCommand", V_STRING) Then GoTo Finally
1971 If Not ScriptForge.SF_Utils._Validate(DirectSQL, "DirectSQL", ScriptForge.V_BOOLEAN) Then GoTo Finally
1972 End If
1974 ' Check the existence of FileName
1976 If Len(RegistrationName) = 0 Then GoTo CatchError
1978 If Not oDBContext.hasRegisteredDatabase(RegistrationName) Then GoTo CatchError
1979 FileName = ScriptForge.SF_FileSystem._ConvertFromUrl(oDBContext.getDatabaseLocation(RegistrationName))
1980 End If
1981 If Not ScriptForge.SF_FileSystem.FileExists(FileName) Then GoTo CatchError
1983 Try:
1984 ' Check command type
1985 Set oDatabase = ScriptForge.SF_Services.CreateScriptService("SFDatabases.Database", FileName, , True) ' Read-only
1986 If IsNull(oDatabase) Then GoTo CatchError
1987 With oDatabase
1988 If ScriptForge.SF_Array.Contains(.Tables, SQLCommand) Then
1989 bDirect = True
1990 lCommandType = com.sun.star.sheet.DataImportMode.TABLE
1991 ElseIf ScriptForge.SF_Array.Contains(.Queries, SQLCommand) Then
1992 Set oQuery = .XConnection.Queries.getByName(SQLCommand)
1993 bDirect = Not oQuery.EscapeProcessing
1994 lCommandType = com.sun.star.sheet.DataImportMode.QUERY
1995 Else
1996 bDirect = DirectSQL
1997 lCommandType = com.sun.star.sheet.DataImportMode.SQL
1998 SQLCommand = ._ReplaceSquareBrackets(SQLCommand)
1999 End If
2000 .CloseDatabase()
2001 Set oDatabase = oDatabase.Dispose()
2002 End With
2004 ' Determine the destination cell as the top-left coordinates of the given range
2005 Set oDestRange = _ParseAddress(DestinationCell)
2006 Set oDestAddress = oDestRange.XCellRange.RangeAddress
2007 Set oDestCell = oDestRange.XSpreadsheet.getCellByPosition(oDestAddress.StartColumn, oDestAddress.StartRow)
2009 ' Remember current selection
2010 Set oSelect = _Component.CurrentController.getSelection()
2011 ' Import arguments
2012 vImportOptions = Array(_
2013 ScriptForge.SF_Utils._MakePropertyValue("DatabaseName", ScriptForge.SF_FileSystem._ConvertToUrl(FileName)) _
2017 )
2018 oDestCell.doImport(vImportOptions)
2019 ' Restore selection after import_
2020 _RestoreSelections(_Component, oSelect)
2022 Finally:
2023 ScriptForge.SF_Utils._ExitFunction(cstThisSub)
2024 Exit Sub
2025 Catch:
2026 GoTo Finally
2027 CatchError:
2028 SF_Exception.RaiseFatal(BASEDOCUMENTOPENERROR, "FileName", FileName, "RegistrationName", RegistrationName)
2029 GoTo Finally
2030 End Sub ' SFDocuments.SF_Calc.ImportFromDatabase
2032 REM -----------------------------------------------------------------------------
2033 Public Function InsertSheet(Optional ByVal SheetName As Variant _
2034 , Optional ByVal BeforeSheet As Variant _
2035 ) As Boolean
2036 ''' Insert a new empty sheet before an existing sheet or at the end of the list of sheets
2037 ''' Args:
2038 ''' SheetName: The name of the new sheet
2039 ''' BeforeSheet: The name (string) or index (numeric, starting from 1) of the sheet before which to insert
2040 ''' Returns:
2041 ''' True if the sheet could be inserted successfully
2042 ''' Examples:
2045 Dim bInsert As Boolean ' Return value
2046 Dim vSheets As Variant ' List of existing sheets
2047 Dim lSheetIndex As Long ' Index of a sheet
2051 If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
2052 bInsert = False
2054 Check:
2055 If IsMissing(BeforeSheet) Or IsEmpty(BeforeSheet) Then BeforeSheet = 32768
2056 If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
2057 If Not _IsStillAlive(True) Then GoTo Finally
2060 End If
2061 vSheets = _Component.getSheets.getElementNames()
2063 Try:
2064 If VarType(BeforeSheet) = V_STRING Then
2065 lSheetIndex = ScriptForge.SF_Array.IndexOf(vSheets, BeforeSheet)
2066 Else
2067 lSheetIndex = BeforeSheet - 1
2070 End If
2071 _Component.getSheets.insertNewByName(SheetName, lSheetIndex)
2072 bInsert = True
2074 Finally:
2075 InsertSheet = binsert
2076 ScriptForge.SF_Utils._ExitFunction(cstThisSub)
2077 Exit Function
2078 Catch:
2079 GoTo Finally
2080 End Function ' SFDocuments.SF_Calc.InsertSheet
2082 REM -----------------------------------------------------------------------------
2083 Public Function Methods() As Variant
2084 ''' Return the list of public methods of the Calc service as an array
2086 Methods = Array( _
2127 )
2129 End Function ' SFDocuments.SF_Calc.Methods
2131 REM -----------------------------------------------------------------------------
2132 Public Function MoveRange(Optional ByVal Source As Variant _
2133 , Optional ByVal Destination As Variant _
2134 ) As String
2135 ''' Move a specified source range to a destination range
2136 ''' Args:
2137 ''' Source: the source range of cells as a string
2138 ''' Destination: the destination of the moved range of cells, as a string
2139 ''' If given as a range of cells, the destination will be reduced to its top-left cell
2140 ''' Returns:
2141 ''' A string representing the modified range of cells
2142 ''' The modified area depends only on the size of the source area
2143 ''' Examples:
2146 Dim sMove As String ' Return value
2147 Dim oSource As Object ' Alias of Source to avoid "Object variable not set" run-time error
2148 Dim oSourceAddress As Object ' com.sun.star.table.CellRangeAddress
2149 Dim oDestRange As Object ' Destination as a range
2150 Dim oDestAddress As Object ' com.sun.star.table.CellRangeAddress
2151 Dim oDestCell As Object ' com.sun.star.table.CellAddress
2152 Dim oSelect As Object ' Current selection in source
2153 Dim oClipboard As Object ' com.sun.star.datatransfer.XTransferable
2154 Dim oCellRanges As Object ' com.sun.star.sheet.SheetCellRanges
2155 Dim vRangeAddresses As Variant ' Array of com.sun.star.table.CellRangeAddress
2156 Dim i As Long
2161 If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
2162 sMove = ""
2164 Check:
2165 If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
2166 If Not _IsStillAlive(True) Then GoTo Finally
2169 End If
2171 Try:
2172 Set oSourceAddress = _ParseAddress(Source).XCellRange.RangeAddress
2173 Set oDestRange = _ParseAddress(Destination)
2174 Set oDestAddress = oDestRange.XCellRange.RangeAddress
2175 Set oDestCell = New com.sun.star.table.CellAddress
2176 With oDestAddress
2177 oDestCell.Sheet = .Sheet
2178 oDestCell.Column = .StartColumn
2179 oDestCell.Row = .StartRow
2180 End With
2181 oDestRange.XSpreadsheet.moveRange(oDestCell, oSourceAddress)
2183 With oSourceAddress
2184 sMove = _Offset(Destination, 0, 0, .EndRow - .StartRow + 1, .EndColumn - .StartColumn + 1).RangeName
2185 End With
2187 Finally:
2188 MoveRange = sMove
2189 ScriptForge.SF_Utils._ExitFunction(cstThisSub)
2190 Exit Function
2191 Catch:
2192 GoTo Finally
2193 End Function ' SFDocuments.SF_Calc.MoveRange
2195 REM -----------------------------------------------------------------------------
2196 Public Function MoveSheet(Optional ByVal SheetName As Variant _
2197 , Optional ByVal BeforeSheet As Variant _
2198 ) As Boolean
2199 ''' Move a sheet before an existing sheet or at the end of the list of sheets
2200 ''' Args:
2201 ''' SheetName: The name of the sheet to move
2202 ''' BeforeSheet: The name (string) or index (numeric, starting from 1) of the sheet before which to move the sheet
2203 ''' Returns:
2204 ''' True if the sheet could be moved successfully
2205 ''' Examples:
2208 Dim bMove As Boolean ' Return value
2209 Dim vSheets As Variant ' List of existing sheets
2210 Dim lSheetIndex As Long ' Index of a sheet
2214 If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
2215 bMove = False
2217 Check:
2218 If IsMissing(BeforeSheet) Or IsEmpty(BeforeSheet) Then BeforeSheet = 32768
2219 If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
2220 If Not _IsStillAlive(True) Then GoTo Finally
2223 End If
2224 vSheets = _Component.getSheets.getElementNames()
2226 Try:
2227 If VarType(BeforeSheet) = V_STRING Then
2228 lSheetIndex = ScriptForge.SF_Array.IndexOf(vSheets, BeforeSheet)
2229 Else
2230 lSheetIndex = BeforeSheet - 1
2233 End If
2234 _Component.getSheets.MoveByName(SheetName, lSheetIndex)
2235 bMove = True
2237 Finally:
2238 MoveSheet = bMove
2239 ScriptForge.SF_Utils._ExitFunction(cstThisSub)
2240 Exit Function
2241 Catch:
2242 GoTo Finally
2243 End Function ' SFDocuments.SF_Calc.MoveSheet
2245 REM -----------------------------------------------------------------------------
2246 Public Function Offset(Optional ByRef Range As Variant _
2247 , Optional ByVal Rows As Variant _
2248 , Optional ByVal Columns As Variant _
2249 , Optional ByVal Height As Variant _
2250 , Optional ByVal Width As Variant _
2251 ) As String
2252 ''' Returns a new range offset by a certain number of rows and columns from a given range
2253 ''' Args:
2254 ''' Range : the range, as a string, from which the function searches for the new range
2255 ''' Rows : the number of rows by which the reference was corrected up (negative value) or down.
2257 ''' Columns : the number of columns by which the reference was corrected to the left (negative value) or to the right.
2259 ''' Height : the vertical height for an area that starts at the new reference position.
2260 ''' Default = no vertical resizing
2261 ''' Width : the horizontal width for an area that starts at the new reference position.
2262 ''' Default - no horizontal resizing
2263 ''' Arguments Rows and Columns must not lead to zero or negative start row or column.
2264 ''' Arguments Height and Width must not lead to zero or negative count of rows or columns.
2265 ''' Returns:
2266 ''' A new range as a string
2267 ''' Exceptions:
2268 ''' OFFSETADDRESSERROR The computed range of cells falls beyond the sheet boundaries
2269 ''' Examples:
2270 ''' oDoc.Offset("A1", 2, 2) ' "'SheetX'.$C$3" (A1 moved by two rows and two columns down)
2271 ''' oDoc.Offset("A1", 2, 2, 5, 6) ' "'SheetX'.$C$3:$H$7"
2273 Dim sOffset As String ' Return value
2274 Dim oAddress As Object ' Alias of Range
2278 If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
2279 sOffset = ""
2281 Check:
2282 If IsMissing(Rows) Or IsEmpty(Rows) Then Rows = 0
2283 If IsMissing(Columns) Or IsEmpty(Columns) Then Columns = 0
2284 If IsMissing(Height) Or IsEmpty(Height) Then Height = 0
2285 If IsMissing(Width) Or IsEmpty(Width) Then Width = 0
2286 If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
2287 If Not _IsStillAlive() Then GoTo Finally
2289 If Not ScriptForge.SF_Utils._Validate(Rows, "Rows", ScriptForge.V_NUMERIC) Then GoTo Finally
2290 If Not ScriptForge.SF_Utils._Validate(Columns, "Columns", ScriptForge.V_NUMERIC) Then GoTo Finally
2291 If Not ScriptForge.SF_Utils._Validate(Height, "Height", ScriptForge.V_NUMERIC) Then GoTo Finally
2292 If Not ScriptForge.SF_Utils._Validate(Width, "Width", ScriptForge.V_NUMERIC) Then GoTo Finally
2293 End If
2295 Try:
2296 ' Define the new range string
2297 Set oAddress = _Offset(Range, Rows, Columns, Height, Width)
2298 sOffset = oAddress.RangeName
2300 Finally:
2301 Offset = sOffset
2302 ScriptForge.SF_Utils._ExitFunction(cstThisSub)
2303 Exit Function
2304 Catch:
2305 GoTo Finally
2306 End Function ' SFDocuments.SF_Calc.Offset
2308 REM -----------------------------------------------------------------------------
2309 Public Function OpenRangeSelector(Optional ByVal Title As Variant _
2310 , Optional ByVal Selection As Variant _
2311 , Optional ByVal SingleCell As Variant _
2312 , Optional ByVal CloseAfterSelect As Variant _
2313 ) As String
2314 ''' Activates the Calc document, opens a non-modal dialog with a text box,
2315 ''' let the user make a selection in the current or another sheet and
2316 ''' returns the selected area as a string.
2317 ''' This method does not change the current selection.
2318 ''' Args:
2319 ''' Title: the title to display on the top of the dialog
2320 ''' Selection: a default preselection as a String. When absent, the first element of the
2321 ''' current selection is preselected.
2322 ''' SingleCell: When True, only a single cell may be selected. Default = False
2323 ''' CloseAfterSelect: When True (default-, the dialog is closed immediately after
2324 ''' the selection. When False, the user may change his/her mind and must close
2325 ''' the dialog manually.
2326 ''' Returns:
2327 ''' The selected range as a string, or the empty string when the user cancelled the request (close window button)
2328 ''' Exceptions:
2329 ''' Examples:
2330 ''' Dim sSelect As String, vValues As Variant
2333 ''' vValues = oDoc.GetValue(sSelect)
2335 Dim sSelector As String ' Return value
2336 Dim vPropertyValues As Variant ' Array of com.sun.star.beans.PropertyValue
2337 Dim oSelection As Object ' The current selection before opening the selector
2338 Dim oAddress As Object ' Preselected address as _Address
2341 Const cstSubArgs = "[Title=""""], [Selection=""~""], [SingleCell=False], [CloseAfterSelect=True]"
2343 If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
2344 sSelector = ""
2346 Check:
2347 If IsMissing(Title) Or IsEmpty(Title) Then Title = ""
2349 If IsMissing(SingleCell) Or IsEmpty(SingleCell) Then SingleCell = False
2350 If IsMissing(CloseAfterSelect) Or IsEmpty(CloseAfterSelect) Then CloseAfterSelect = True
2351 If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
2352 If Not _IsStillAlive() Then GoTo Finally
2354 If Not ScriptForge.SF_Utils._Validate(Selection, "Selection", V_STRING) Then GoTo Finally
2355 If Not ScriptForge.SF_Utils._Validate(SingleCell, "SingleCell", ScriptForge.V_BOOLEAN) Then GoTo Finally
2356 If Not ScriptForge.SF_Utils._Validate(CloseAfterSelect, "CloseAfterSelect", ScriptForge.V_BOOLEAN) Then GoTo Finally
2357 End If
2359 Try:
2360 ' Save the current selections
2361 Set oSelection = _Component.CurrentController.getSelection()
2363 ' Process preselection and select its containing sheet
2364 Set oAddress = _ParseAddress(Selection)
2365 Activate(oAddress.SheetName)
2367 ' Build arguments array and execute the dialog box
2368 With ScriptForge.SF_Utils
2369 vPropertyValues = Array( _
2374 )
2375 End With
2376 sSelector = SF_DocumentListener.RunRangeSelector(_Component, vPropertyValues)
2378 ' Restore the saved selections
2379 _RestoreSelections(_Component, oSelection)
2381 Finally:
2382 OpenRangeSelector = sSelector
2383 ScriptForge.SF_Utils._ExitFunction(cstThisSub)
2384 Exit Function
2385 Catch:
2386 GoTo Finally
2387 End Function ' SFDocuments.SF_Calc.OpenRangeSelector
2389 REM -----------------------------------------------------------------------------
2390 Public Function Printf(Optional ByVal InputStr As Variant _
2391 , Optional ByVal Range As Variant _
2392 , Optional ByVal TokenCharacter As Variant _
2393 ) As String
2394 ''' Returns the input string after substitution of its tokens by
2395 ''' their values in the given range
2396 ''' This method is usually used in combination with SetFormula()
2397 ''' The accepted tokens are:
2398 ''' - %S The sheet name containing the range, including single quotes when necessary
2399 ''' - %R1 The row number of the topleft part of the range
2400 ''' - %C1 The column letter of the topleft part of the range
2401 ''' - %R2 The row number of the bottomright part of the range
2402 ''' - %C2 The column letter of the bottomright part of the range
2403 ''' Args:
2404 ''' InputStr: usually a Calc formula or a part of a formula, but may be any string
2405 ''' Range: the range, as a string from which the values of the tokens are derived
2407 ''' Double the TokenCharacter to not consider it as a token.
2408 ''' Returns:
2409 ''' The input string after substitution of the contained tokens
2410 ''' Exceptions:
2411 ''' Examples:
2412 ''' Assume we have in A1:E10 a matrix of numbers. To obtain the sum by row in F1:F10 ...
2413 ''' Dim range As String, formula As String
2415 ''' formula = "=SUM($%C1%R1:$%C2%R1)" ' "=SUM($A1:$E1)", note the relative references
2417 ''' 'F1 will contain =Sum($A1:$E1)
2418 ''' 'F2 =Sum($A2:$E2)
2419 ''' ' ...
2421 Dim sPrintf As String ' Return value
2422 Dim vSubstitute As Variants ' Array of strings representing the token values
2423 Dim oAddress As Object ' A range as an _Address object
2424 Dim sSheetName As String ' The %S token value
2425 Dim sC1 As String ' The %C1 token value
2426 Dim sR1 As String ' The %R1 token value
2427 Dim sC2 As String ' The %C2 token value
2428 Dim sR2 As String ' The %R2 token value
2429 Dim i As Long
2435 If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
2436 sPrintf = ""
2438 Check:
2440 If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
2441 If Not _IsStillAlive() Then GoTo Finally
2442 If Not ScriptForge.SF_Utils._Validate(InputStr, "InputStr", V_STRING) Then GoTo Finally
2444 If Not ScriptForge.SF_Utils._Validate(TokenCharacter, "TokenCharacter", V_STRING) Then GoTo Finally
2445 End If
2447 Try:
2448 ' Define the token values
2449 Set oAddress = _ParseAddress(Range)
2450 With oAddress.XCellRange
2451 sC1 = _GetColumnName(.RangeAddress.StartColumn + 1)
2452 sR1 = CStr(.RangeAddress.StartRow + 1)
2453 sC2 = _GetColumnName(.RangeAddress.EndColumn + 1)
2454 sR2 = CStr(.RangeAddress.EndRow + 1)
2455 sSheetName = _QuoteSheetName(oAddress.XSpreadsheet.Name)
2456 End With
2458 ' Substitute tokens by their values
2459 sPrintf = ScriptForge.SF_String.ReplaceStr(InputStr _
2460 , Array(TokenCharacter & TokenCharacter _
2466 , cstPseudoToken _
2467 ) _
2468 , Array(cstPseudoToken _
2469 , sR1 _
2470 , sC1 _
2471 , sR2 _
2472 , sC2 _
2473 , sSheetName _
2474 , TokenCharacter _
2475 ) _
2476 )
2478 Finally:
2479 Printf = sPrintf
2480 ScriptForge.SF_Utils._ExitFunction(cstThisSub)
2481 Exit Function
2482 Catch:
2483 GoTo Finally
2484 End Function ' SFDocuments.SF_Calc.Printf
2486 REM -----------------------------------------------------------------------------
2487 Public Function PrintOut(Optional ByVal SheetName As Variant _
2488 , Optional ByVal Pages As Variant _
2489 , Optional ByVal Copies As Variant _
2490 ) As Boolean
2491 ''' Send the content of the given sheet to the printer.
2492 ''' The printer might be defined previously by default, by the user or by the SetPrinter() method
2493 ''' Args:
2494 ''' SheetName: the sheet to print. Default = the active sheet
2495 ''' Pages: the pages to print as a string, like in the user interface. Example: "1-4;10;15-18". Default = all pages
2496 ''' Copies: the number of copies
2497 ''' Returns:
2498 ''' True when successful
2499 ''' Examples:
2502 Dim bPrint As Boolean ' Return value
2503 Dim oSheet As Object ' SheetName as a reference
2506 Const cstSubArgs = "[SheetName=""~""], [Pages=""""], [Copies=1]"
2508 If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
2509 bPrint = False
2511 Check:
2512 If IsMissing(SheetName) Or IsEmpty(SheetName) Then SheetName = ""
2513 If IsMissing(Pages) Or IsEmpty(Pages) Then Pages = ""
2514 If IsMissing(Copies) Or IsEmpty(Copies) Then Copies = 1
2516 If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
2517 If Not _IsStillAlive() Then GoTo Finally
2520 If Not ScriptForge.SF_Utils._Validate(Copies, "Copies", ScriptForge.V_NUMERIC) Then GoTo Finally
2521 End If
2523 Try:
2525 ' Make given sheet active
2527 With _Component
2528 Set oSheet = .getSheets.getByName(SheetName)
2529 Set .CurrentController.ActiveSheet = oSheet
2530 End With
2531 End If
2533 bPrint = [_Super].PrintOut(Pages, Copies, _Component)
2535 Finally:
2536 PrintOut = bPrint
2537 ScriptForge.SF_Utils._ExitFunction(cstThisSub)
2538 Exit Function
2539 Catch:
2540 GoTo Finally
2541 End Function ' SFDocuments.SF_Calc.PrintOut
2543 REM -----------------------------------------------------------------------------
2544 Public Function Properties() As Variant
2545 ''' Return the list or properties of the Calc class as an array
2547 Properties = Array( _
2583 )
2585 End Function ' SFDocuments.SF_Calc.Properties
2587 REM -----------------------------------------------------------------------------
2588 Public Function RemoveDuplicates(Optional ByVal Range As Variant _
2589 , Optional ByVal Columns As Variant _
2590 , Optional ByVal Header As Variant _
2591 , Optional ByVal CaseSensitive As Variant _
2592 , Optional ByVal Mode As Variant _
2593 ) As String
2594 ''' Remove duplicate values from a range of values.
2595 ''' The comparison between rows is done on a subset of the columns in the range.
2596 ''' The resulting range replaces the input range, in which, either:
2597 ''' all duplicate rows are cleared from their content
2598 ''' all duplicate rows are suppressed and rows below are pushed upwards.
2599 ''' Anyway, the first copy of each set of duplicates is kept and the initial sequence is preserved.
2600 ''' Args:
2601 ''' Range: the range, as a string, from which the duplicate rows should be removed
2602 ''' Columns: an array of column numbers to compare; items are in the interval [1 .. range width]
2603 ''' Default = the first column in the range
2604 ''' Header: when True, the first row is a header row. Default = False.
2605 ''' CaseSensitive: for string comparisons. Default = False.
2607 ''' For large ranges, the "COMPACT" mode is probably significantly slower.
2608 ''' Returns:
2609 ''' The resulting range as a string
2610 ''' Examples:
2611 ''' oCalc.RemoveDuplicates("Sheet1.B2:K11", Array(1, 2), Header := True, CaseSensitive := True)
2613 Dim sRemove As String ' Return value
2614 Dim oRangeAddress As Object ' Parsed range as an _Address object
2615 Dim sMirrorRange As String ' Mirror of initial range
2616 Dim lRandom As Long ' Random number to build the worksheet name
2617 Dim sWorkSheet As String ' Name of worksheet
2618 Dim vRows() As Variant ' Array of row numbers
2619 Dim sRowsRange As String ' Range of the last column of the worksheet
2620 Dim sFullMirrorRange As String ' Mirrored data + rows column
2621 Dim sLastRowsRange As String ' Same as sRowsRange without the first cell
2622 Dim sDuplicates As String ' Formula identifying a duplicate row
2623 Dim lColumn As Long ' Single column number
2624 Dim sColumn As String ' Single column name
2625 Dim sFilter As String ' Filter formula for final compaction or clearing
2628 Const cstSubArgs = "Range, [Columns], [Header=False], [CaseSensitive=False], [Mode=""COMPACT""|""CLEAR""]"
2630 If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
2631 sRemove = ""
2633 Check:
2634 If IsMissing(Columns) Or IsEmpty(Columns) Then Columns = Array(1)
2635 If Not IsArray(Columns) Then Columns = Array(Columns)
2636 If IsMissing(Header) Or IsEmpty(Header) Then Header = False
2637 If IsMissing(CaseSensitive) Or IsEmpty(CaseSensitive) Then CaseSensitive = False
2639 If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
2640 If Not _IsStillAlive(True) Then GoTo Finally
2642 If Not ScriptForge.SF_Utils._ValidateArray(Columns, "Columns", 1, ScriptForge.V_NUMERIC, True) Then GoTo Finally
2643 If Not ScriptForge.SF_Utils._Validate(Header, "Header", ScriptForge.V_BOOLEAN) Then GoTo Finally
2644 If Not ScriptForge.SF_Utils._Validate(CaseSensitive, "CaseSensitive", ScriptForge.V_BOOLEAN) Then GoTo Finally
2645 If Not ScriptForge.SF_Utils._Validate(Mode, "Mode", V_STRING, Array("COMPACT", "CLEAR")) Then GoTo Finally
2646 End If
2648 Try:
2649 ' Let's assume the initial range is "$Sheet1.$B$11:$K$110" (100 rows, 10 columns, no header)
2650 ' Ignore header, consider only the effective data
2651 If Header Then Set oRangeAddress = _Offset(Range, 1, 0, Height(Range) - 1, 0) Else Set oRangeAddress = _ParseAddress(Range)
2656 InsertSheet(sWorkSheet)
2658 sMirrorRange = CopyToCell(oRangeAddress, "$" & sWorkSheet & ".$A$1")
2662 With oRangeAddress.XCellRange
2663 vRows = ScriptForge.RangeInit(CLng(.RangeAddress.StartRow + 1), CLng(.RangeAddress.EndRow + 1))
2664 End With
2670 sFullMirrorRange = Offset(sMirrorRange, , , , Width(sMirrorRange) + 1)
2671 SortRange(sFullMirrorRange, SortKeys := Columns, CaseSensitive := CaseSensitive)
2678 For Each lColumn In Columns
2679 sColumn = _GetColumnName(lColumn)
2680 If CaseSensitive Then
2681 sDuplicates = sDuplicates & ";$" & sColumn & "2=$" & sColumn & "1"
2682 Else
2683 sDuplicates = sDuplicates & ";UPPER($" & sColumn & "2)=UPPER($" & sColumn & "1)"
2684 End If
2685 Next lColumn
2689 '** Step 5: Compact or clear the rows in the initial range that are not retained in the final row numbers list
2692 Select Case UCase(Mode)
2694 sRemove = CompactUp(oRangeAddress.RangeName, WholeRow := False, FilterFormula := sFilter)
2698 If Header Then sRemove = _ParseAddress(Range).RangeName Else sRemove = oRangeAddress.RangeName
2699 End Select
2701 '** Housekeeping
2702 RemoveSheet(sWorkSheet)
2704 Finally:
2705 RemoveDuplicates = sRemove
2706 ScriptForge.SF_Utils._ExitFunction(cstThisSub)
2707 Exit Function
2708 Catch:
2709 GoTo Finally
2710 End Function ' SFDocuments.SF_Calc.RemoveDuplicates
2712 REM -----------------------------------------------------------------------------
2713 Public Function RemoveSheet(Optional ByVal SheetName As Variant) As Boolean
2714 ''' Remove an existing sheet from the document
2715 ''' Args:
2716 ''' SheetName: The name of the sheet to remove
2717 ''' Returns:
2718 ''' True if the sheet could be removed successfully
2719 ''' Examples:
2722 Dim bRemove As Boolean ' Return value
2726 If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
2727 bRemove = False
2729 Check:
2730 If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
2731 If Not _IsStillAlive(True) Then GoTo Finally
2733 End If
2735 Try:
2736 _Component.getSheets.RemoveByName(SheetName)
2737 bRemove = True
2739 Finally:
2740 RemoveSheet = bRemove
2741 ScriptForge.SF_Utils._ExitFunction(cstThisSub)
2742 Exit Function
2743 Catch:
2744 GoTo Finally
2745 End Function ' SFDocuments.SF_Calc.RemoveSheet
2747 REM -----------------------------------------------------------------------------
2748 Public Function RenameSheet(Optional ByVal SheetName As Variant _
2749 , Optional ByVal NewName As Variant _
2750 ) As Boolean
2751 ''' Rename a specified sheet
2752 ''' Args:
2753 ''' SheetName: The name of the sheet to rename
2754 ''' NewName: Must not exist
2755 ''' Returns:
2756 ''' True if the sheet could be renamed successfully
2757 ''' Exceptions:
2758 ''' DUPLICATESHEETERROR A sheet with the given name exists already
2759 ''' Examples:
2762 Dim bRename As Boolean ' Return value
2766 If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
2767 bRename = False
2769 Check:
2770 If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
2771 If Not _IsStillAlive(True) Then GoTo Finally
2774 End If
2776 Try:
2777 _Component.getSheets.getByName(SheetName).setName(NewName)
2778 bRename = True
2780 Finally:
2781 RenameSheet = bRename
2782 ScriptForge.SF_Utils._ExitFunction(cstThisSub)
2783 Exit Function
2784 Catch:
2785 GoTo Finally
2786 End Function ' SFDocuments.SF_Calc.RenameSheet
2788 REM -----------------------------------------------------------------------------
2789 Public Function SetArray(Optional ByVal TargetCell As Variant _
2790 , Optional ByRef Value As Variant _
2791 ) As String
2792 ''' Set the given (array of) values starting from the target cell
2793 ''' The updated area expands itself from the target cell or from the top-left corner of the given range
2794 ''' as far as determined by the size of the input Value.
2795 ''' Vectors are always expanded vertically
2796 ''' Args:
2797 ''' TargetCell : the cell or the range as a string that should receive a new value
2798 ''' Value: a scalar, a vector or an array with the new values
2799 ''' The new values should be strings, numeric values or dates. Other types empty the corresponding cell
2800 ''' Returns:
2801 ''' A string representing the updated range
2802 ''' Exceptions:
2803 ''' OFFSETADDRESSERROR The computed range of cells falls beyond the sheet boundaries
2804 ''' Examples:
2807 Dim sSet As String ' Return value
2808 Dim oSet As Object ' _Address alias of sSet
2809 Dim vDataArray As Variant ' DataArray compatible with .DataArray UNO property
2813 If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
2814 sSet = ""
2816 Check:
2817 If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
2818 If Not _IsStillAlive() Then GoTo Finally
2819 If Not ScriptForge.SF_Utils._Validate(TargetCell, "TargetCell", V_STRING) Then GoTo Finally
2820 If IsArray(Value) Then
2822 Else
2824 End If
2825 End If
2827 Try:
2828 ' Convert argument to data array and derive new range from its size
2829 vDataArray = _ConvertToDataArray(Value)
2830 If UBound(vDataArray) < LBound(vDataArray) Then GoTo Finally
2831 Set oSet = _Offset(TargetCell, 0, 0, plHeight := UBound(vDataArray) + 1, plWidth := UBound(vDataArray(0)) + 1) ' +1 : vDataArray is zero-based
2832 With oSet
2833 .XCellRange.setDataArray(vDataArray)
2834 sSet = .RangeName
2835 End With
2837 Finally:
2838 SetArray = sSet
2839 ScriptForge.SF_Utils._ExitFunction(cstThisSub)
2840 Exit Function
2841 Catch:
2842 GoTo Finally
2843 End Function ' SFDocuments.SF_Calc.SetArray
2845 REM -----------------------------------------------------------------------------
2846 Public Function SetCellStyle(Optional ByVal TargetRange As Variant _
2847 , Optional ByVal Style As Variant _
2848 , Optional ByVal FilterFormula As Variant _
2849 , Optional ByVal FilterScope As Variant _
2850 ) As String
2851 ''' Apply the given cell style in the given range
2852 ''' If the cell style does not exist, an error is raised
2853 ''' The range is updated and the remainder of the sheet is left untouched
2854 ''' Either the full range is updated or a selection based on a FilterFormula
2855 ''' Args:
2856 ''' TargetRange : the range as a string that should receive a new cell style
2857 ''' Style: the style name as a string
2858 ''' FilterFormula: a Calc formula to select among the given Range
2859 ''' When left empty, all the cells of the range are formatted with the new style
2860 ''' FilterScope: "CELL" (default value), "ROW" or "COLUMN"
2861 ''' When FilterFormula is present, FilterScope is mandatory
2862 ''' Returns:
2863 ''' A string representing the updated range
2864 ''' Examples:
2866 ''' oDoc.SetCellStype("A1:J20", "Wrong", "=(A1<0)", "CELL")
2868 Dim sSet As String ' Return value
2869 Dim oAddress As _Address ' Alias of TargetRange
2870 Dim oStyleFamilies As Object ' com.sun.star.container.XNameAccess
2871 Dim vStyles As Variant ' Array of existing cell styles
2872 Dim vRanges() As Variant ' Array of filtered ranges
2873 Dim i As Long
2877 Const cstSubArgs = "TargetRange, Style, [FilterFormula=""], [FilterScope=""CELL""|""ROW""|""COLUMN""]"
2879 If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
2880 sSet = ""
2882 Check:
2883 If IsMissing(FilterFormula) Or IsEmpty(FilterFormula) Then FilterFormula = ""
2885 If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
2886 If Not _IsStillAlive() Then GoTo Finally
2887 If Not ScriptForge.SF_Utils._Validate(TargetRange, "TargetRange", Array(V_STRING, ScriptForge.V_OBJECT)) Then GoTo Finally
2888 ' Check that the given style really exists
2889 Set oStyleFamilies = _Component.StyleFamilies
2890 If oStyleFamilies.hasByName(cstStyle) Then vStyles = oStyleFamilies.getByName(cstStyle).getElementNames() Else vStyles = Array()
2891 If Not ScriptForge.SF_Utils._Validate(Style, "Style", V_STRING, vStyles) Then GoTo Finally
2892 ' Filter formula
2893 If Not ScriptForge.SF_Utils._Validate(FilterFormula, "FilterFormula", V_STRING) Then GoTo Finally
2895 If Not ScriptForge.SF_Utils._Validate(FilterScope, "FilterScope", V_STRING, Array("CELL", "ROW", "COLUMN")) Then GoTo Finally
2896 Else
2897 If Not ScriptForge.SF_Utils._Validate(FilterScope, "FilterScope", V_STRING) Then GoTo Finally
2898 End If
2899 End If
2901 Try:
2902 If VarType(TargetRange) = V_STRING Then Set oAddress = _ParseAddress(TargetRange) Else Set oAddress = TargetRange
2903 With oAddress
2905 .XCellRange.CellStyle = Style
2906 Else ' When the range has to be cut in subranges
2907 vRanges() = _ComputeFilter(oAddress, FilterFormula, UCase(FilterScope))
2908 For i = 0 To UBound(vRanges)
2909 vRanges(i).XCellRange.CellStyle = Style
2910 Next i
2911 End If
2912 sSet = .RangeName
2913 End With
2915 Finally:
2916 SetCellStyle = sSet
2917 ScriptForge.SF_Utils._ExitFunction(cstThisSub)
2918 Exit Function
2919 Catch:
2920 GoTo Finally
2921 End Function ' SFDocuments.SF_Calc.SetCellStyle
2923 REM -----------------------------------------------------------------------------
2924 Public Function SetFormula(Optional ByVal TargetRange As Variant _
2925 , Optional ByRef Formula As Variant _
2926 ) As String
2927 ''' Set the given (array of) formulae in the given range
2928 ''' The full range is updated and the remainder of the sheet is left untouched
2929 ''' If the given formula is a string:
2930 ''' the unique formula is pasted across the whole range with adjustment of the relative references
2931 ''' Otherwise
2932 ''' If the size of Formula < the size of Range, then the other cells are emptied
2933 ''' If the size of Formula > the size of Range, then Formula is only partially copied
2934 ''' Vectors are always expanded vertically, except if the range has a height of exactly 1 row
2935 ''' Args:
2936 ''' TargetRange : the range as a string that should receive a new Formula
2937 ''' Formula: a scalar, a vector or an array with the new formula(e) as strings for each cell of the range.
2938 ''' Returns:
2939 ''' A string representing the updated range
2940 ''' Examples:
2942 ''' oDoc.SetFormula("A1:F1", Array("=A2", "=B2", "=C2+10")) ' Horizontal vector, partially empty
2943 ''' oDoc.SetFormula("A1:D2", "=E1") ' D2 contains the formula "=H2"
2945 Dim sSet As String ' Return value.XSpreadsheet.Name)
2946 Dim oAddress As Object ' Alias of TargetRange
2947 Dim vDataArray As Variant ' DataArray compatible with .DataArray UNO property
2951 If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
2952 sSet = ""
2954 Check:
2955 If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
2956 If Not _IsStillAlive() Then GoTo Finally
2957 If Not ScriptForge.SF_Utils._Validate(TargetRange, "TargetRange", Array(V_STRING, ScriptForge.V_OBJECT)) Then GoTo Finally
2958 If IsArray(Formula) Then
2959 If Not ScriptForge.SF_Utils._ValidateArray(Formula, "Formula", 0, V_STRING) Then GoTo Finally
2960 Else
2961 If Not ScriptForge.SF_Utils._Validate(Formula, "Formula", V_STRING) Then GoTo Finally
2962 End If
2963 End If
2965 Try:
2966 If VarType(TargetRange) = V_STRING Then Set oAddress = _ParseAddress(TargetRange) Else Set oAddress = TargetRange
2967 With oAddress
2968 If IsArray(Formula) Then
2969 ' Convert to data array and limit its size to the size of the initial range
2971 If UBound(vDataArray) < LBound(vDataArray) Then GoTo Finally
2972 .XCellRange.setFormulaArray(vDataArray)
2973 Else
2974 With .XCellRange
2975 ' Store formula in top-left cell and paste it along the whole range
2977 .fillSeries(com.sun.star.sheet.FillDirection.TO_BOTTOM, com.sun.star.sheet.FillMode.SIMPLE, 0, 0, 0)
2978 .fillSeries(com.sun.star.sheet.FillDirection.TO_RIGHT, com.sun.star.sheet.FillMode.SIMPLE, 0, 0, 0)
2979 End With
2980 End If
2981 sSet = .RangeName
2982 End With
2984 Finally:
2985 SetFormula = sSet
2986 ScriptForge.SF_Utils._ExitFunction(cstThisSub)
2987 Exit Function
2988 Catch:
2989 GoTo Finally
2990 End Function ' SFDocuments.SF_Calc.SetFormula
2992 REM -----------------------------------------------------------------------------
2993 Private Function SetProperty(Optional ByVal psProperty As String _
2994 , Optional ByVal pvValue As Variant _
2995 ) As Boolean
2996 ''' Set the new value of the named property
2997 ''' Args:
2998 ''' psProperty: the name of the property
2999 ''' pvValue: the new value of the given property
3000 ''' Returns:
3001 ''' True if successful
3003 Dim bSet As Boolean ' Return value
3004 Static oSession As Object ' Alias of SF_Session
3005 Dim cstThisSub As String
3008 If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
3009 bSet = False
3012 If IsMissing(pvValue) Then pvValue = Empty
3013 'ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) ' Validation done in Property Lets
3015 If IsNull(oSession) Then Set oSession = ScriptForge.SF_Services.CreateScriptService("Session")
3016 bSet = True
3017 Select Case UCase(psProperty)
3019 CurrentSelection = pvValue
3021 CustomProperties = pvValue
3023 Description = pvValue
3025 Keywords = pvValue
3027 Subject = pvValue
3029 Title = pvValue
3030 Case Else
3031 bSet = False
3032 End Select
3034 Finally:
3035 SetProperty = bSet
3036 'ScriptForge.SF_Utils._ExitFunction(cstThisSub)
3037 Exit Function
3038 Catch:
3039 GoTo Finally
3040 End Function ' SFDocuments.SF_Calc.SetProperty
3042 REM -----------------------------------------------------------------------------
3043 Public Function SetValue(Optional ByVal TargetRange As Variant _
3044 , Optional ByRef Value As Variant _
3045 ) As String
3046 ''' Set the given value in the given range
3047 ''' The full range is updated and the remainder of the sheet is left untouched
3048 ''' If the size of Value < the size of Range, then the other cells are emptied
3049 ''' If the size of Value > the size of Range, then Value is only partially copied
3050 ''' Vectors are always expanded vertically, except if the range has a height of exactly 1 row
3051 ''' Args:
3052 ''' TargetRange : the range as a string that should receive a new value
3053 ''' Value: a scalar, a vector or an array with the new values for each cell o.XSpreadsheet.Name)f the range.
3054 ''' The new values should be strings, numeric values or dates. Other types empty the corresponding cell
3055 ''' Returns:
3056 ''' A string representing the updated range
3057 ''' Examples:
3059 ''' oDoc.SetValue("A1:F1", Array(1, 2, 3)) ' Horizontal vector, partially empty
3060 ''' oDoc.SetValue("A1:D2", SF_Array.AppendRow(Array(1, 2, 3, 4), Array(5, 6, 7, 8)))
3062 Dim sSet As String ' Return value
3063 Dim oAddress As Object ' Alias of TargetRange
3064 Dim vDataArray As Variant ' DataArray compatible with .DataArray UNO property
3068 If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
3069 sSet = ""
3071 Check:
3072 If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
3073 If Not _IsStillAlive() Then GoTo Finally
3074 If Not ScriptForge.SF_Utils._Validate(TargetRange, "TargetRange", V_STRING) Then GoTo Finally
3075 If IsArray(Value) Then
3077 Else
3079 End If
3080 End If
3082 Try:
3083 Set oAddress = _ParseAddress(TargetRange)
3084 With oAddress
3085 ' Convert to data array and limit its size to the size of the initial range
3087 If UBound(vDataArray) < LBound(vDataArray) Then GoTo Finally
3088 .XCellRange.setDataArray(vDataArray)
3089 sSet = .RangeName
3090 End With
3092 Finally:
3093 SetValue = sSet
3094 ScriptForge.SF_Utils._ExitFunction(cstThisSub)
3095 Exit Function
3096 Catch:
3097 GoTo Finally
3098 End Function ' SFDocuments.SF_Calc.SetValue
3100 REM -----------------------------------------------------------------------------
3101 Public Function ShiftDown(Optional ByVal Range As Variant _
3102 , Optional ByVal WholeRow As Variant _
3103 , Optional ByVal Rows As Variant _
3104 ) As String
3105 ''' Move a specified range and all cells below in the same columns downwards by inserting empty cells
3106 ''' The inserted cells can span whole rows or be limited to the width of the range
3107 ''' The height of the inserted area is provided by the Rows argument
3108 ''' Nothing happens if the range shift crosses one of the edges of the worksheet
3109 ''' The execution of the method has no effect on the current selection
3110 ''' Args:
3111 ''' Range: the range above which cells have to be inserted, as a string
3112 ''' WholeRow: when True (default = False), insert whole rows
3113 ''' Rows: the height of the area to insert. Default = the height of the Range argument
3114 ''' Returns:
3115 ''' A string representing the new location of the initial range
3116 ''' Examples:
3117 ''' newrange = oDoc.ShiftDown("SheetX.A1:F10") ' "$SheetX.$A$11:$F$20"
3118 ''' newrange = oDoc.ShiftDown("SheetX.A1:F10", Rows := 3) ' "$SheetX.$A$4:$F$13"
3120 Dim sShift As String ' Return value
3121 Dim oSourceAddress As Object ' Alias of Range as _Address
3122 Dim lHeight As Long ' Range height
3123 Dim oShiftAddress As Object ' com.sun.star.table.CellRangeAddress - Range adjusted to the right width
3124 Dim lShiftMode As Long ' One of the com.sun.star.sheet.CellInsertMode enum values
3129 If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
3130 sShift = ""
3132 Check:
3133 If IsMissing(WholeRow) Or IsEmpty(WholeRow) Then WholeRow = False
3134 If IsMissing(Rows) Or IsEmpty(Rows) Then Rows = 0
3135 If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
3136 If Not _IsStillAlive(True) Then GoTo Finally
3138 If Not ScriptForge.SF_Utils._Validate(WholeRow, "WholeRow", ScriptForge.V_BOOLEAN) Then GoTo Finally
3139 If Not ScriptForge.SF_Utils._Validate(Rows, "Rows", ScriptForge.V_NUMERIC) Then GoTo Finally
3140 End If
3142 Try:
3143 Set oSourceAddress = _ParseAddress(Range)
3145 With oSourceAddress
3147 ' Manage the height of the area to shift
3148 ' The insertCells() method inserts a number of rows equal to the height of the cell range to shift
3149 lHeight = .Height
3152 If Rows <> lHeight Then
3154 Else
3155 Set oShiftAddress = .XCellRange.RangeAddress
3156 End If
3158 ' Determine the shift mode
3159 With com.sun.star.sheet.CellInsertMode
3160 If WholeRow Then lShiftMode = .ROWS Else lShiftMode = .DOWN
3161 End With
3163 ' Move the cells as requested. This modifies .XCellRange
3164 .XSpreadsheet.insertCells(oShiftAddress, lShiftMode)
3166 ' Determine the receiving area
3167 sShift = .XCellRange.AbsoluteName
3169 End With
3171 Finally:
3172 ShiftDown = sShift
3173 ScriptForge.SF_Utils._ExitFunction(cstThisSub)
3174 Exit Function
3175 Catch:
3176 ' When error, return the original range
3177 If Not IsNull(oSourceAddress) Then sShift = oSourceAddress.RangeName
3178 GoTo Finally
3179 End Function ' SFDocuments.SF_Calc.ShiftDown
3181 REM -----------------------------------------------------------------------------
3182 Public Function ShiftLeft(Optional ByVal Range As Variant _
3183 , Optional ByVal WholeColumn As Variant _
3184 , Optional ByVal Columns As Variant _
3185 ) As String
3186 ''' Delete the leftmost columns of a specified range and move all cells at their right leftwards
3187 ''' The deleted cells can span whole columns or be limited to the height of the range
3188 ''' The width of the deleted area is provided by the Columns argument
3189 ''' The execution of the method has no effect on the current selection
3190 ''' Args:
3191 ''' Range: the range in which cells have to be erased, as a string
3192 ''' WholeColumn: when True (default = False), erase whole columns
3193 ''' Columns: the width of the area to delete.
3194 ''' Default = the width of the Range argument, it is also its maximum value
3195 ''' Returns:
3196 ''' A string representing the location of the remaining part of the initial range,
3197 ''' or the zero-length string if the whole range has been deleted
3198 ''' Examples:
3199 ''' newrange = oDoc.ShiftLeft("SheetX.G1:L10") ' """
3200 ''' newrange = oDoc.ShiftLeft("SheetX.G1:L10", Columns := 3) ' "$SheetX.$G$1:$I$10"
3202 Dim sShift As String ' Return value
3203 Dim oSourceAddress As Object ' Alias of Range as _Address
3204 Dim lWidth As Long ' Range width
3205 Dim oShiftAddress As Object ' com.sun.star.table.CellRangeAddress - Range adjusted to the right width
3206 Dim lShiftMode As Long ' One of the com.sun.star.sheet.CellDeleteMode enum values
3211 If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
3212 sShift = ""
3214 Check:
3215 If IsMissing(WholeColumn) Or IsEmpty(WholeColumn) Then WholeColumn = False
3216 If IsMissing(Columns) Or IsEmpty(Columns) Then Columns = 0
3217 If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
3218 If Not _IsStillAlive(True) Then GoTo Finally
3220 If Not ScriptForge.SF_Utils._Validate(WholeColumn, "WholeColumn", ScriptForge.V_BOOLEAN) Then GoTo Finally
3221 If Not ScriptForge.SF_Utils._Validate(Columns, "Columns", ScriptForge.V_NUMERIC) Then GoTo Finally
3222 End If
3224 Try:
3225 Set oSourceAddress = _ParseAddress(Range)
3226 Set _LastParsedAddress = Nothing ' Range will be erased. Force re-parsing next time
3228 With oSourceAddress
3230 ' Manage the width of the area to delete
3231 ' The removeRange() method erases a number of columns equal to the width of the cell range to delete
3232 lWidth = .Width
3234 If Columns < lWidth Then
3236 Else ' Columns is capped at the range width
3237 Set oShiftAddress = .XCellRange.RangeAddress
3238 End If
3240 ' Determine the Delete mode
3241 With com.sun.star.sheet.CellDeleteMode
3242 If WholeColumn Then lShiftMode = .COLUMNS Else lShiftMode = .LEFT
3243 End With
3245 ' Move the cells as requested. This modifies .XCellRange
3246 .XSpreadsheet.removeRange(oShiftAddress, lShiftMode)
3248 ' Determine the remaining area
3249 If Columns < lWidth Then sShift = .XCellRange.AbsoluteName
3251 End With
3253 Finally:
3254 ShiftLeft = sShift
3255 ScriptForge.SF_Utils._ExitFunction(cstThisSub)
3256 Exit Function
3257 Catch:
3258 ' When error, return the original range
3259 If Not IsNull(oSourceAddress) Then sShift = oSourceAddress.RangeName
3260 GoTo Finally
3261 End Function ' SFDocuments.SF_Calc.ShiftLeft
3263 REM -----------------------------------------------------------------------------
3264 Public Function ShiftRight(Optional ByVal Range As Variant _
3265 , Optional ByVal WholeColumn As Variant _
3266 , Optional ByVal Columns As Variant _
3267 ) As String
3268 ''' Move a specified range and all next cells in the same rows to the right by inserting empty cells
3269 ''' The inserted cells can span whole columns or be limited to the height of the range
3270 ''' The width of the inserted area is provided by the Columns argument
3271 ''' Nothing happens if the range shift crosses one of the edges of the worksheet
3272 ''' The execution of the method has no effect on the current selection
3273 ''' Args:
3274 ''' Range: the range before which cells have to be inserted, as a string
3275 ''' WholeColumn: when True (default = False), insert whole columns
3276 ''' Columns: the width of the area to insert. Default = the width of the Range argument
3277 ''' Returns:
3278 ''' A string representing the new location of the initial range
3279 ''' Examples:
3280 ''' newrange = oDoc.ShiftRight("SheetX.A1:F10") ' "$SheetX.$G$1:$L$10"
3281 ''' newrange = oDoc.ShiftRight("SheetX.A1:F10", Columns := 3) ' "$SheetX.$D$1:$I$10"
3283 Dim sShift As String ' Return value
3284 Dim oSourceAddress As Object ' Alias of Range as _Address
3285 Dim lWidth As Long ' Range width
3286 Dim oShiftAddress As Object ' com.sun.star.table.CellRangeAddress - Range adjusted to the right width
3287 Dim lShiftMode As Long ' One of the com.sun.star.sheet.CellInsertMode enum values
3292 If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
3293 sShift = ""
3295 Check:
3296 If IsMissing(WholeColumn) Or IsEmpty(WholeColumn) Then WholeColumn = False
3297 If IsMissing(Columns) Or IsEmpty(Columns) Then Columns = 0
3298 If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
3299 If Not _IsStillAlive(True) Then GoTo Finally
3301 If Not ScriptForge.SF_Utils._Validate(WholeColumn, "WholeColumn", ScriptForge.V_BOOLEAN) Then GoTo Finally
3302 If Not ScriptForge.SF_Utils._Validate(Columns, "Columns", ScriptForge.V_NUMERIC) Then GoTo Finally
3303 End If
3305 Try:
3306 Set oSourceAddress = _ParseAddress(Range)
3308 With oSourceAddress
3310 ' Manage the width of the area to Shift
3311 ' The insertCells() method inserts a number of columns equal to the width of the cell range to Shift
3312 lWidth = .Width
3315 If Columns <> lWidth Then
3317 Else
3318 Set oShiftAddress = .XCellRange.RangeAddress
3319 End If
3321 ' Determine the Shift mode
3322 With com.sun.star.sheet.CellInsertMode
3323 If WholeColumn Then lShiftMode = .COLUMNS Else lShiftMode = .RIGHT
3324 End With
3326 ' Move the cells as requested. This modifies .XCellRange
3327 .XSpreadsheet.insertCells(oShiftAddress, lShiftMode)
3329 ' Determine the receiving area
3330 sShift = .XCellRange.AbsoluteName
3332 End With
3334 Finally:
3335 ShiftRight = sShift
3336 ScriptForge.SF_Utils._ExitFunction(cstThisSub)
3337 Exit Function
3338 Catch:
3339 ' When error, return the original range
3340 If Not IsNull(oSourceAddress) Then sShift = oSourceAddress.RangeName
3341 GoTo Finally
3342 End Function ' SFDocuments.SF_Calc.ShiftRight
3344 REM -----------------------------------------------------------------------------
3345 Public Function ShiftUp(Optional ByVal Range As Variant _
3346 , Optional ByVal WholeRow As Variant _
3347 , Optional ByVal Rows As Variant _
3348 ) As String
3349 ''' Delete the topmost rows of a specified range and move all cells below upwards
3350 ''' The deleted cells can span whole rows or be limited to the width of the range
3351 ''' The height of the deleted area is provided by the Rows argument
3352 ''' The execution of the method has no effect on the current selection
3353 ''' Args:
3354 ''' Range: the range in which cells have to be erased, as a string
3355 ''' WholeRow: when True (default = False), erase whole rows
3356 ''' Rows: the height of the area to delete.
3357 ''' Default = the height of the Range argument, it is also its maximum value
3358 ''' Returns:
3359 ''' A string representing the location of the remaining part of the initial range,
3360 ''' or the zero-length string if the whole range has been deleted
3361 ''' Examples:
3363 ''' newrange = oDoc.ShiftUp("SheetX.G1:L10", Rows := 3) ' "$SheetX.$G$1:$I$10"
3365 Dim sShift As String ' Return value
3366 Dim oSourceAddress As Object ' Alias of Range as _Address
3367 Dim lHeight As Long ' Range height
3368 Dim oShiftAddress As Object ' com.sun.star.table.CellRangeAddress - Range adjusted to the right height
3369 Dim lShiftMode As Long ' One of the com.sun.star.sheet.CellDeleteMode enum values
3374 If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
3375 sShift = ""
3377 Check:
3378 If IsMissing(WholeRow) Or IsEmpty(WholeRow) Then WholeRow = False
3379 If IsMissing(Rows) Or IsEmpty(Rows) Then Rows = 0
3380 If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
3381 If Not _IsStillAlive(True) Then GoTo Finally
3383 If Not ScriptForge.SF_Utils._Validate(WholeRow, "WholeRow", ScriptForge.V_BOOLEAN) Then GoTo Finally
3384 If Not ScriptForge.SF_Utils._Validate(Rows, "Rows", ScriptForge.V_NUMERIC) Then GoTo Finally
3385 End If
3387 Try:
3388 Set oSourceAddress = _ParseAddress(Range)
3389 Set _LastParsedAddress = Nothing ' Range will be erased. Force re-parsing next time
3391 With oSourceAddress
3393 ' Manage the height of the area to delete
3394 ' The removeRange() method erases a number of rows equal to the height of the cell range to delete
3395 lHeight = .Height
3397 If Rows < lHeight Then
3399 Else ' Rows is capped at the range height
3400 Set oShiftAddress = .XCellRange.RangeAddress
3401 End If
3403 ' Determine the Delete mode
3404 With com.sun.star.sheet.CellDeleteMode
3405 If WholeRow Then lShiftMode = .ROWS Else lShiftMode = .UP
3406 End With
3408 ' Move the cells as requested. This modifies .XCellRange
3409 .XSpreadsheet.removeRange(oShiftAddress, lShiftMode)
3411 ' Determine the remaining area
3412 If Rows < lHeight Then sShift = .XCellRange.AbsoluteName
3414 End With
3416 Finally:
3417 ShiftUp = sShift
3418 ScriptForge.SF_Utils._ExitFunction(cstThisSub)
3419 Exit Function
3420 Catch:
3421 ' When error, return the original range
3422 If Not IsNull(oSourceAddress) Then sShift = oSourceAddress.RangeName
3423 GoTo Finally
3424 End Function ' SFDocuments.SF_Calc.ShiftUp
3426 REM -----------------------------------------------------------------------------
3427 Public Function SortRange(Optional ByVal Range As Variant _
3428 , Optional ByVal SortKeys As Variant _
3429 , Optional ByVal SortOrder As Variant _
3430 , Optional ByVal DestinationCell As Variant _
3431 , Optional ByVal ContainsHeader As Variant _
3432 , Optional ByVal CaseSensitive As Variant _
3433 , Optional ByVal SortColumns As Variant _
3434 ) As Variant
3435 ''' Sort the given range on any number of columns/rows. The sorting order may vary by column/row
3436 ''' If the number of sort keys is > 3 then the range is sorted several times, by groups of 3 keys,
3437 ''' starting from the last key. In this context the algorithm used by Calc to sort ranges
3438 ''' is presumed STABLE, i.e. it maintains the relative order of records with equal keys.
3439 '''
3440 ''' Args:
3441 ''' Range: the range to sort as a string
3442 ''' SortKeys: a scalar (if 1 column/row) or an array of column/row numbers starting from 1
3443 ''' SortOrder: a scalar or an array of strings: "ASC" or "DESC"
3444 ''' Each item is paired with the corresponding item in SortKeys
3445 ''' If the SortOrder array is shorter than SortKeys, the remaining keys are sorted
3446 ''' in ascending order
3447 ''' DestinationCell: the destination of the sorted range of cells, as a string
3448 ''' If given as range, the destination will be reduced to its top-left cell
3449 ''' By default, Range is overwritten with its sorted content
3450 ''' ContainsHeader: when True, the first row/column is not sorted. Default = False
3451 ''' CaseSensitive: only for string comparisons, default = False
3452 ''' SortColumns: when True, the columns are sorted from left to right
3453 ''' Default = False: rows are sorted from top to bottom.
3454 ''' Returns:
3455 ''' The modified range of cells as a string
3456 ''' Example:
3457 ''' oDoc.SortRange("A2:J200", Array(1, 3), , Array("ASC", "DESC"), CaseSensitive := True)
3458 ''' ' Sort on columns A (ascending) and C (descending)
3460 Dim sSort As String ' Return value
3461 Dim oRangeAddress As _Address ' Parsed range
3462 Dim oRange As Object ' com.sun.star.table.XCellRange
3463 Dim oSortRange As Object ' The area to sort as an _Address object
3464 Dim oDestRange As Object ' Destination as a range
3465 Dim oDestAddress As Object ' com.sun.star.table.CellRangeAddress
3466 Dim oDestCell As Object ' com.sun.star.table.CellAddress
3467 Dim vSortDescriptor As Variant ' Array of com.sun.star.beans.PropertyValue
3468 Dim vSortFields As Variant ' Array of com.sun.star.table.TableSortField
3469 Dim sOrder As String ' Item in SortOrder
3470 Dim lSort As Long ' Counter for sub-sorts
3471 Dim lKeys As Long ' UBound of SortKeys
3472 Dim lKey As Long ' Actual index in SortKeys
3473 Dim i As Long, j As Long
3477 Const cstSubArgs = "Range, SortKeys, [TargetRange=""""], [SortOrder=""ASC""], [DestinationCell=""""], [ContainsHeader=False], [CaseSensitive=False], [SortColumns=False]"
3479 If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
3480 sSort = ""
3482 Check:
3483 If IsMissing(SortKeys) Or IsEmpty(SortKeys) Then
3484 SortKeys = Array(1)
3485 ElseIf Not IsArray(SortKeys) Then
3486 SortKeys = Array(SortKeys)
3487 End If
3488 If IsMissing(DestinationCell) Or IsEmpty(DestinationCell) Then DestinationCell = ""
3489 If IsMissing(SortOrder) Or IsEmpty(SortOrder) Then
3491 ElseIf Not IsArray(SortOrder) Then
3492 SortOrder = Array(SortOrder)
3493 End If
3494 If IsMissing(ContainsHeader) Or IsEmpty(ContainsHeader) Then ContainsHeader = False
3495 If IsMissing(CaseSensitive) Or IsEmpty(CaseSensitive) Then CaseSensitive = False
3496 If IsMissing(SortColumns) Or IsEmpty(SortColumns) Then SortColumns = False
3497 If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
3498 If Not _IsStillAlive() Then GoTo Finally
3500 If Not ScriptForge.SF_Utils._ValidateArray(SortKeys, "SortKeys", 1, V_NUMERIC, True) Then GoTo Finally
3501 If Not ScriptForge.SF_Utils._Validate(DestinationCell, "DestinationCell", V_STRING) Then GoTo Finally
3502 If Not ScriptForge.SF_Utils._ValidateArray(SortOrder, "SortOrder", 1, V_STRING, True) Then GoTo Finally
3503 If Not ScriptForge.SF_Utils._Validate(ContainsHeader, "ContainsHeader", ScriptForge.V_BOOLEAN) Then GoTo Finally
3504 If Not ScriptForge.SF_Utils._Validate(CaseSensitive, "CaseSensitive", ScriptForge.V_BOOLEAN) Then GoTo Finally
3505 If Not ScriptForge.SF_Utils._Validate(SortColumns, "SortColumns", ScriptForge.V_BOOLEAN) Then GoTo Finally
3506 End If
3507 Set oRangeAddress = _ParseAddress(Range)
3508 If Len(DestinationCell) > 0 Then Set oDestRange = _ParseAddress(DestinationCell) Else Set oDestRange = Nothing
3510 Try:
3511 ' Initialize a generic sort descriptor
3512 Set oRange = oRangeAddress.XCellRange
3513 vSortDescriptor = oRange.createSortDescriptor ' Makes a generic sort descriptor for ranges
3514 vSortDescriptor = ScriptForge.SF_Utils._SetPropertyValue(vSortDescriptor, "IsSortColumns", SortColumns)
3515 vSortDescriptor = ScriptForge.SF_Utils._SetPropertyValue(vSortDescriptor, "ContainsHeader", ContainsHeader)
3516 vSortDescriptor = ScriptForge.SF_Utils._SetPropertyValue(vSortDescriptor, "BindFormatsToContent", True)
3517 vSortDescriptor = ScriptForge.SF_Utils._SetPropertyValue(vSortDescriptor, "IsUserListEnabled", False)
3519 ' Sort by keys group
3521 lKeys = UBound(SortKeys)
3522 lSort = Int(lKeys / cstMaxKeys)
3523 Set oSortRange = oRangeAddress
3527 ' The 1st sort must consider the destination area. Next sorts are done on the destination area
3529 vSortDescriptor = ScriptForge.SF_Utils._SetPropertyValue(vSortDescriptor, "CopyOutputData", False)
3530 vSortDescriptor = ScriptForge.SF_Utils._SetPropertyValue(vSortDescriptor, "OutputPosition", Nothing)
3531 Else
3532 Set oDestAddress = oDestRange.XCellRange.RangeAddress
3533 Set oDestCell = New com.sun.star.table.CellAddress
3534 With oDestAddress
3535 oDestCell.Sheet = .Sheet
3536 oDestCell.Column = .StartColumn
3537 oDestCell.Row = .StartRow
3538 End With
3539 vSortDescriptor = ScriptForge.SF_Utils._SetPropertyValue(vSortDescriptor, "CopyOutputData", True)
3540 vSortDescriptor = ScriptForge.SF_Utils._SetPropertyValue(vSortDescriptor, "OutputPosition", oDestCell)
3541 End If
3543 ' Define the sorting keys
3544 vSortFields = DimArray(lKeys Mod cstMaxKeys)
3545 For i = 0 To UBound(vSortFields)
3546 vSortFields(i) = New com.sun.star.table.TableSortField
3547 lKey = j * cstMaxKeys + i
3550 With vSortFields(i)
3551 .Field = SortKeys(lKey) - 1
3553 .IsCaseSensitive = CaseSensitive
3554 End With
3555 Next i
3556 lKeys = lKeys - UBound(vSortFields) - 1
3558 ' Associate the keys and the descriptor, and sort
3559 vSortDescriptor = ScriptForge.SF_Utils._SetPropertyValue(vSortDescriptor, "SortFields", vSortFields)
3560 oSortRange.XCellRange.sort(vSortDescriptor)
3562 ' Next loop, if any, is done on the destination area
3563 If Len(DestinationCell) > 0 And j = lSort And lSort > 0 Then Set oSortRange = _Offset(oDestRange, 0, 0, oRangeAddress.Height, oRangeAddress.Width)
3565 Next j
3567 ' Compute the changed area
3568 If Len(DestinationCell) = 0 Then
3569 sSort = oRangeAddress.RangeName
3570 Else
3571 With oRangeAddress
3573 End With
3574 End If
3576 Finally:
3577 SortRange = sSort
3578 ScriptForge.SF_Utils._ExitFunction(cstThisSub)
3579 Exit Function
3580 Catch:
3581 GoTo Finally
3582 End Function ' SFDocuments.SF_Calc.SortRange
3584 REM ======================================================= SUPERCLASS PROPERTIES
3586 REM -----------------------------------------------------------------------------
3587 Property Get CustomProperties() As Variant
3589 End Property ' SFDocuments.SF_Calc.CustomProperties
3591 REM -----------------------------------------------------------------------------
3592 Property Let CustomProperties(Optional ByVal pvCustomProperties As Variant)
3593 [_Super].CustomProperties = pvCustomProperties
3594 End Property ' SFDocuments.SF_Calc.CustomProperties
3596 REM -----------------------------------------------------------------------------
3597 Property Get Description() As Variant
3599 End Property ' SFDocuments.SF_Calc.Description
3601 REM -----------------------------------------------------------------------------
3602 Property Let Description(Optional ByVal pvDescription As Variant)
3603 [_Super].Description = pvDescription
3604 End Property ' SFDocuments.SF_Calc.Description
3606 REM -----------------------------------------------------------------------------
3607 Property Get DocumentProperties() As Variant
3609 End Property ' SFDocuments.SF_Calc.DocumentProperties
3611 REM -----------------------------------------------------------------------------
3612 Property Get DocumentType() As String
3614 End Property ' SFDocuments.SF_Calc.DocumentType
3616 REM -----------------------------------------------------------------------------
3617 Property Get ExportFilters() As Variant
3619 End Property ' SFDocuments.SF_Calc.ExportFilters
3621 REM -----------------------------------------------------------------------------
3622 Property Get ImportFilters() As Variant
3624 End Property ' SFDocuments.SF_Calc.ImportFilters
3626 REM -----------------------------------------------------------------------------
3627 Property Get IsBase() As Boolean
3629 End Property ' SFDocuments.SF_Calc.IsBase
3631 REM -----------------------------------------------------------------------------
3632 Property Get IsCalc() As Boolean
3634 End Property ' SFDocuments.SF_Calc.IsCalc
3636 REM -----------------------------------------------------------------------------
3637 Property Get IsDraw() As Boolean
3639 End Property ' SFDocuments.SF_Calc.IsDraw
3641 REM -----------------------------------------------------------------------------
3642 Property Get IsFormDocument() As Boolean
3644 End Property ' SFDocuments.SF_Writer.IsFormDocument
3646 REM -----------------------------------------------------------------------------
3647 Property Get IsImpress() As Boolean
3649 End Property ' SFDocuments.SF_Calc.IsImpress
3651 REM -----------------------------------------------------------------------------
3652 Property Get IsMath() As Boolean
3654 End Property ' SFDocuments.SF_Calc.IsMath
3656 REM -----------------------------------------------------------------------------
3657 Property Get IsWriter() As Boolean
3659 End Property ' SFDocuments.SF_Calc.IsWriter
3661 REM -----------------------------------------------------------------------------
3662 Property Get Keywords() As Variant
3664 End Property ' SFDocuments.SF_Calc.Keywords
3666 REM -----------------------------------------------------------------------------
3667 Property Let Keywords(Optional ByVal pvKeywords As Variant)
3668 [_Super].Keywords = pvKeywords
3669 End Property ' SFDocuments.SF_Calc.Keywords
3671 REM -----------------------------------------------------------------------------
3672 Property Get Readonly() As Variant
3674 End Property ' SFDocuments.SF_Calc.Readonly
3676 REM -----------------------------------------------------------------------------
3677 Property Get Subject() As Variant
3679 End Property ' SFDocuments.SF_Calc.Subject
3681 REM -----------------------------------------------------------------------------
3682 Property Let Subject(Optional ByVal pvSubject As Variant)
3683 [_Super].Subject = pvSubject
3684 End Property ' SFDocuments.SF_Calc.Subject
3686 REM -----------------------------------------------------------------------------
3687 Property Get Title() As Variant
3689 End Property ' SFDocuments.SF_Calc.Title
3691 REM -----------------------------------------------------------------------------
3692 Property Let Title(Optional ByVal pvTitle As Variant)
3693 [_Super].Title = pvTitle
3694 End Property ' SFDocuments.SF_Calc.Title
3696 REM -----------------------------------------------------------------------------
3697 Property Get XComponent() As Variant
3699 End Property ' SFDocuments.SF_Calc.XComponent
3701 REM ========================================================== SUPERCLASS METHODS
3703 REM -----------------------------------------------------------------------------
3704 'Public Function Activate() As Boolean
3705 ' Activate = [_Super].Activate()
3708 REM -----------------------------------------------------------------------------
3709 Public Function CloseDocument(Optional ByVal SaveAsk As Variant) As Boolean
3710 CloseDocument = [_Super].CloseDocument(SaveAsk)
3711 End Function ' SFDocuments.SF_Calc.CloseDocument
3713 REM -----------------------------------------------------------------------------
3714 Public Function CreateMenu(Optional ByVal MenuHeader As Variant _
3715 , Optional ByVal Before As Variant _
3716 , Optional ByVal SubmenuChar As Variant _
3717 ) As Object
3718 Set CreateMenu = [_Super].CreateMenu(MenuHeader, Before, SubmenuChar)
3719 End Function ' SFDocuments.SF_Calc.CreateMenu
3721 REM -----------------------------------------------------------------------------
3722 Public Sub Echo(Optional ByVal EchoOn As Variant _
3723 , Optional ByVal Hourglass As Variant _
3724 )
3725 [_Super].Echo(EchoOn, Hourglass)
3726 End Sub ' SFDocuments.SF_Calc.Echo
3728 REM -----------------------------------------------------------------------------
3729 Public Function ExportAsPDF(Optional ByVal FileName As Variant _
3730 , Optional ByVal Overwrite As Variant _
3731 , Optional ByVal Pages As Variant _
3732 , Optional ByVal Password As Variant _
3733 , Optional ByVal Watermark As Variant _
3734 ) As Boolean
3735 ExportAsPDF = [_Super].ExportAsPDF(FileName, Overwrite, Pages, Password, Watermark)
3736 End Function ' SFDocuments.SF_Calc.ExportAsPDF
3738 REM -----------------------------------------------------------------------------
3739 Public Function RemoveMenu(Optional ByVal MenuHeader As Variant) As Boolean
3740 RemoveMenu = [_Super].RemoveMenu(MenuHeader)
3741 End Function ' SFDocuments.SF_Calc.RemoveMenu
3743 REM -----------------------------------------------------------------------------
3744 Public Sub RunCommand(Optional ByVal Command As Variant _
3745 , ParamArray Args As Variant _
3746 )
3747 [_Super].RunCommand(Command, Args)
3748 End Sub ' SFDocuments.SF_Calc.RunCommand
3750 REM -----------------------------------------------------------------------------
3751 Public Function Save() As Boolean
3752 Save = [_Super].Save()
3753 End Function ' SFDocuments.SF_Calc.Save
3755 REM -----------------------------------------------------------------------------
3756 Public Function SaveAs(Optional ByVal FileName As Variant _
3757 , Optional ByVal Overwrite As Variant _
3758 , Optional ByVal Password As Variant _
3759 , Optional ByVal FilterName As Variant _
3760 , Optional ByVal FilterOptions As Variant _
3761 ) As Boolean
3762 SaveAs = [_Super].SaveAs(FileName, Overwrite, Password, FilterName, FilterOptions)
3763 End Function ' SFDocuments.SF_Calc.SaveAs
3765 REM -----------------------------------------------------------------------------
3766 Public Function SaveCopyAs(Optional ByVal FileName As Variant _
3767 , Optional ByVal Overwrite As Variant _
3768 , Optional ByVal Password As Variant _
3769 , Optional ByVal FilterName As Variant _
3770 , Optional ByVal FilterOptions As Variant _
3771 ) As Boolean
3772 SaveCopyAs = [_Super].SaveCopyAs(FileName, Overwrite, Password, FilterName, FilterOptions)
3773 End Function ' SFDocuments.SF_Calc.SaveCopyAs
3775 REM -----------------------------------------------------------------------------
3776 Public Function SetPrinter(Optional ByVal Printer As Variant _
3777 , Optional ByVal Orientation As Variant _
3778 , Optional ByVal PaperFormat As Variant _
3779 ) As Boolean
3780 SetPrinter = [_Super].SetPrinter(Printer, Orientation, PaperFormat)
3781 End Function ' SFDocuments.SF_Calc.SetPrinter
3783 REM -----------------------------------------------------------------------------
3784 Public Function Toolbars(Optional ByVal ToolbarName As Variant) As Variant
3785 Toolbars = [_Super].Toolbars(ToolbarName)
3786 End Function ' SFDocuments.SF_Calc.Toolbars
3788 REM =========================================================== PRIVATE FUNCTIONS
3790 REM -----------------------------------------------------------------------------
3791 Private Sub _ClearRange(ByVal psTarget As String _
3792 , Optional ByVal Range As Variant _
3793 , Optional FilterFormula As Variant _
3794 , Optional FilterScope As Variant _
3795 )
3796 ''' Clear the given range with the given options
3797 ''' The range may be filtered by a formula for a selective clearance
3798 ''' Arguments checking is done in this Sub, not in the calling one
3799 ''' Args:
3801 ''' Range: the range to clear as a string
3802 ''' FilterFormula: a selection of cells based on a Calc formula
3803 ''' When left empty, all the cells of the range are cleared
3806 Dim lClear As Long ' A combination of com.sun.star.sheet.CellFlags
3807 Dim oRange As Object ' Alias of Range
3808 Dim vRanges() As Variant ' Array of subranges resulting from the application of the filter
3809 Dim i As Long
3812 Const cstSubArgs = "Range, [FilterFormula=""], [FilterScope=""CELL""|""ROW""|""COLUMN""]"
3814 If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
3816 Check:
3817 If IsMissing(FilterFormula) Or IsEmpty(FilterFormula) Then FilterFormula = ""
3819 If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
3820 If Not _IsStillAlive() Then GoTo Finally
3821 If Not ScriptForge.SF_Utils._Validate(Range, "Range", Array(V_STRING, ScriptForge.V_OBJECT)) Then GoTo Finally
3822 If Not ScriptForge.SF_Utils._Validate(FilterFormula, "FilterFormula", V_STRING) Then GoTo Finally
3824 If Not ScriptForge.SF_Utils._Validate(FilterScope, "FilterScope", V_STRING, Array("CELL", "ROW", "COLUMN")) Then GoTo Finally
3825 Else
3826 If Not ScriptForge.SF_Utils._Validate(FilterScope, "FilterScope", V_STRING) Then GoTo Finally
3827 End If
3828 End If
3830 Try:
3831 With com.sun.star.sheet.CellFlags
3832 Select Case psTarget
3834 lClear = .VALUE + .DATETIME + .STRING + .ANNOTATION + .FORMULA _
3835 + .HARDATTR + .STYLES + .OBJECTS + .EDITATTR + .FORMATTED
3837 lClear = .HARDATTR + .STYLES + .EDITATTR + .FORMATTED
3839 lClear = .VALUE + .DATETIME + .STRING + .FORMULA
3840 End Select
3841 End With
3843 If VarType(Range) = V_STRING Then Set oRange = _ParseAddress(Range) Else Set oRange = Range
3845 ' Without filter, the whole range is cleared
3846 ' Otherwise the filter cuts the range in subranges and clears them one by one
3847 If Len(FilterFormula) = 0 Then
3848 oRange.XCellRange.clearContents(lClear)
3849 Else
3850 vRanges() = _ComputeFilter(oRange, FilterFormula, UCase(FilterScope))
3851 For i = 0 To UBound(vRanges)
3852 vRanges(i).XCellRange.clearContents(lClear)
3853 Next i
3854 End If
3856 Finally:
3857 ScriptForge.SF_Utils._ExitFunction(cstThisSub)
3858 Exit Sub
3859 Catch:
3860 GoTo Finally
3861 End Sub ' SFDocuments.SF_Calc._ClearRange
3863 REM -----------------------------------------------------------------------------
3864 Private Function _ComputeFilter(ByRef poRange As Object _
3865 , ByVal psFilterFormula As String _
3866 , ByVal psFilterScope As String _
3867 ) As Variant
3868 ''' Compute in the given range the cells, rows or columns for which
3869 ''' the given formula returns TRUE
3870 ''' Args:
3871 ''' poRange: the range on which to compute the filter as an _Address type
3872 ''' psFilterFormula: the formula to be applied on each row, column or cell
3874 ''' Returns:
3875 ''' An array of ranges as objects of type _Address
3877 Dim vRanges As Variant ' Return value
3878 Dim oRange As Object ' A single vRanges() item
3879 Dim lLast As Long ' Last used row or column number in the sheet containing Range
3880 Dim oFormulaRange As _Address ' Range where the FilterFormula must be stored
3881 Dim sFormulaDirection As String ' Either V(ertical), H(orizontal) or B(oth)
3882 Dim vDataArray As Variant ' DataArray compatible with .DataArray UNO property
3883 Dim vFilter As Variant ' Array of Boolean values indicating which rows should be erased
3884 Dim bFilter As Boolean ' A single item in vFilter
3885 Dim iDims As Integer ' Number of dimensions of vFilter()
3886 Dim lLower As Long ' Lower level of contiguous True filter values
3887 Dim lUpper As Long ' Upper level of contiguous True filter values
3888 Dim i As Long, j As Long
3890 Check:
3891 ' Error handling is determined by the calling method
3892 vRanges = Array()
3894 Try:
3895 With poRange
3897 ' Compute the range where to apply the formula
3898 ' Determine the direction of the range containing the formula vertical, horizontal or both
3899 Select Case psFilterScope
3901 lLast = LastColumn(.SheetName)
3902 ' Put formulas as a single column in the unused area at the right of the range to filter
3903 Set oFormulaRange = _Offset(poRange, 0, lLast - .XCellRange.RangeAddress.StartColumn + 1, 0, 1)
3906 lLast = LastRow(.SheetName)
3907 ' Put formulas as a single row in the unused area at the bottom of the range to filter
3911 lLast = LastRow(.SheetName)
3912 ' Put formulas as a matrix in the unused area at the bottom of the range to filter
3915 If oFormulaRange.Width = 1 Then
3917 ElseIf oFormulaRange.Height = 1 Then
3919 End If
3920 End Select
3922 ' Apply the formula and get the result as an array of Boolean values. Clean up
3923 SetFormula(oFormulaRange, psFilterFormula)
3924 vDataArray = oFormulaRange.XCellRange.getDataArray()
3925 vFilter = _ConvertFromDataArray(vDataArray)
3926 iDims = ScriptForge.SF_Array.CountDims(vFilter)
3927 ClearAll(oFormulaRange)
3930 Select Case iDims
3932 If vFilter = 1 Then vRanges = ScriptForge.SF_Array.Append(vRanges, poRange)
3934 ' Nothing to do
3936 ' Strategy: group contiguous applicable rows/columns to optimize heavy operations like CompactUp, CompactLeft
3937 ' Stack the contiguous ranges of True values in vRanges()
3939 ' To manage vector and array with same code, setup a single fictitious loop when vector, otherwise scan array by row
3943 For j = 0 To UBound(vFilter, iDims)
3944 If iDims = 1 Then bFilter = CBool(vFilter(j)) Else bFilter = CBool(vFilter(i, j))
3947 lUpper = j
3948 ElseIf Not bFilter Then
3950 ElseIf bFilter Then
3952 End If
3953 ' Determine the next applicable range when one found and limit reached
3959 Else ' CELL
3961 End If
3962 If Not IsNull(oRange) Then vRanges = ScriptForge.SF_Array.Append(vRanges, oRange)
3964 End If
3965 Next j
3967 Next i
3968 Case Else
3969 ' Should not happen
3970 End Select
3972 End With
3974 Finally:
3975 _ComputeFilter = vRanges()
3976 Exit Function
3977 End Function ' SFDocuments.SF_Calc._ComputeFilter
3979 REM -----------------------------------------------------------------------------
3980 Public Function _ConvertFromDataArray(ByRef pvDataArray As Variant) As Variant
3982 ''' Args:
3983 ''' pvDataArray: an array as returned by the XCellRange.getDataArray or .getFormulaArray methods
3984 ''' Returns:
3985 ''' A scalar, a zero-based 1D array or a zero-based 2D array of strings and/or doubles
3986 ''' To convert doubles to dates, use the CDate builtin function
3988 Dim vArray As Variant ' Return value
3989 Dim lMax1 As Long ' UBound of pvDataArray
3990 Dim lMax2 As Long ' UBound of pvDataArray items
3991 Dim i As Long
3992 Dim j As Long
3994 vArray = Empty
3996 Try:
3997 ' Convert the data array to scalar, vector or array
3998 lMax1 = UBound(pvDataArray)
4000 lMax2 = UBound(pvDataArray(0))
4003 Select Case True
4007 ReDim vArray(0 To lMax1)
4008 For i = 0 To lMax1
4009 vArray(i) = pvDataArray(i)(0)
4010 Next i
4012 ReDim vArray(0 To lMax2)
4013 For j = 0 To lMax2
4014 vArray(j) = pvDataArray(0)(j)
4015 Next j
4016 Case Else ' Array
4018 For i = 0 To lMax1
4019 For j = 0 To lMax2
4020 vArray(i, j) = pvDataArray(i)(j)
4021 Next j
4022 Next i
4023 End Select
4024 End If
4025 End If
4027 Finally:
4028 _ConvertFromDataArray = vArray
4029 End Function ' SFDocuments.SF_Calc._ConvertFromDataArray
4031 REM -----------------------------------------------------------------------------
4032 Private Function _ConvertToCellValue(ByVal pvItem As Variant) As Variant
4033 ''' Convert the argument to a valid Calc cell content
4035 Dim vCell As Variant ' Return value
4037 Try:
4038 Select Case ScriptForge.SF_Utils._VarTypeExt(pvItem)
4039 Case V_STRING : vCell = pvItem
4040 Case V_DATE : vCell = CDbl(pvItem)
4041 Case ScriptForge.V_NUMERIC : vCell = CDbl(pvItem)
4043 Case Else : vCell = ""
4044 End Select
4046 Finally:
4047 _ConvertToCellValue = vCell
4048 Exit Function
4049 End Function ' SFDocuments.SF_Calc._ConvertToCellValue
4051 REM -----------------------------------------------------------------------------
4052 Private Function _ConvertToDataArray(ByRef pvArray As Variant _
4053 , Optional ByVal plRows As Long _
4054 , Optional ByVal plColumns As Long _
4055 ) As Variant
4056 ''' Create a 2-dimensions nested array (compatible with the ranges .DataArray property)
4058 ''' Input may be a 1D array of arrays, typically when call issued by a Python script
4059 ''' Array items are converted to (possibly empty) strings or doubles
4060 ''' Args:
4061 ''' pvArray: the input scalar or array. If array, must be 1 or 2D otherwise it is ignored.
4062 ''' plRows, plColumns: the upper bounds of the data array
4063 ''' If bigger than input array, fill with zero-length strings
4064 ''' If smaller than input array, truncate
4065 ''' If plRows = 0 and the input array is a vector, the data array is aligned horizontally
4066 ''' They are either both present or both absent
4067 ''' When absent
4068 ''' The size of the output is fully determined by the input array
4069 ''' Vectors are aligned vertically
4070 ''' Returns:
4071 ''' A data array compatible with ranges .DataArray property
4072 ''' The output is always an array of nested arrays
4074 Dim vDataArray() As Variant ' Return value
4076 Dim vItem As Variant ' A single input item
4077 Dim iDims As Integer ' Number of dimensions of the input argument
4082 Dim lRows As Long ' Upper bound of vDataArray
4083 Dim lCols As Long ' Upper bound of vVector
4084 Dim bHorizontal As Boolean ' Horizontal vector
4085 Dim bDataArray As Boolean ' Input array is already an array of arrays
4086 Dim i As Long
4087 Dim j As Long
4089 Const cstEmpty = "" ' Empty cell
4091 If IsMissing(plRows) Or IsEmpty(plRows) Then plRows = -1
4092 If IsMissing(plColumns) Or IsEmpty(plColumns) Then plColumns = -1
4094 vDataArray = Array()
4096 Try:
4097 ' Check the input argument and know its boundaries
4098 iDims = ScriptForge.SF_Array.CountDims(pvArray)
4102 Select Case iDims
4104 Case 1
4106 bDataArray = IsArray(pvArray(0))
4107 If Not bDataArray Then
4108 If Not bHorizontal Then
4109 lMin1 = LBound(pvArray) : lMax1 = UBound(pvArray)
4110 Else
4111 lMin2 = LBound(pvArray) : lMax2 = UBound(pvArray)
4112 End If
4113 Else
4114 iDims = 2
4115 lMin1 = LBound(pvArray) : lMax1 = UBound(pvArray)
4117 End If
4118 Case 2
4121 End Select
4123 ' Set the output dimensions accordingly
4125 lRows = plRows
4126 lCols = plColumns
4127 Else ' Dimensions of output determined by input argument
4129 Select Case iDims
4132 lRows = lMax1 - lMin1
4133 Case 2
4134 lRows = lMax1 - lMin1
4135 lCols = lMax2 - lMin2
4136 End Select
4137 End If
4138 ReDim vDataArray(0 To lRows)
4140 ' Feed the output array row by row, each row being a vector
4141 For i = 0 To lRows
4142 ReDim vVector(0 To lCols)
4143 For j = 0 To lCols
4144 If i > lMax1 - lMin1 Then
4145 vVector(j) = cstEmpty
4146 ElseIf j > lMax2 - lMin2 Then
4147 vVector(j) = cstEmpty
4148 Else
4149 Select Case iDims
4150 Case -1 : vItem = _ConvertToCellValue(pvArray)
4151 Case 1
4152 If bHorizontal Then
4153 vItem = _ConvertToCellValue(pvArray(j + lMin2))
4154 Else
4155 vItem = _ConvertToCellValue(pvArray(i + lMin1))
4156 End If
4157 Case 2
4158 If bDataArray Then
4159 vItem = _ConvertToCellValue(pvArray(i + lMin1)(j + lMin2))
4160 Else
4161 vItem = _ConvertToCellValue(pvArray(i + lMin1, j + lMin2))
4162 End If
4163 End Select
4164 vVector(j) = vItem
4165 End If
4166 vDataArray(i) = vVector
4167 Next j
4168 Next i
4170 Finally:
4171 _ConvertToDataArray = vDataArray
4172 Exit Function
4173 End Function ' SFDocuments.SF_Calc._ConvertToDataArray
4175 REM -----------------------------------------------------------------------------
4176 Private Function _DFunction(ByVal psFunction As String _
4177 , Optional ByVal Range As Variant _
4178 ) As Double
4179 ''' Apply the given function on all the numeric values stored in the given range
4180 ''' Args:
4181 ''' Range : the range as a string where to apply the function on
4182 ''' Returns:
4183 ''' The resulting value as a double
4185 Dim dblGet As Double ' Return value
4186 Dim oAddress As Object ' Alias of Range
4187 Dim vFunction As Variant ' com.sun.star.sheet.GeneralFunction.XXX
4191 If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
4192 dblGet = 0
4194 Check:
4195 If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
4196 If Not _IsStillAlive() Then GoTo Finally
4198 End If
4200 Try:
4201 ' Get the data
4202 Set oAddress = _ParseAddress(Range)
4203 Select Case psFunction
4209 Case Else : GoTo Finally
4210 End Select
4211 dblGet = oAddress.XCellRange.computeFunction(vFunction)
4213 Finally:
4214 _DFunction = dblGet
4215 ScriptForge.SF_Utils._ExitFunction(cstThisSub)
4216 Exit Function
4217 Catch:
4218 GoTo Finally
4219 End Function ' SFDocuments.SF_Calc._DFunction
4221 REM -----------------------------------------------------------------------------
4222 Private Function _FileIdent() As String
4223 ''' Returns a file identification from the information that is currently available
4224 ''' Useful e.g. for display in error messages
4226 _FileIdent = [_Super]._FileIdent()
4228 End Function ' SFDocuments.SF_Calc._FileIdent
4230 REM -----------------------------------------------------------------------------
4231 Function _GetColumnName(ByVal plColumnNumber As Long) As String
4232 ''' Convert a column number (range 1, 2,..16384) into its letter counterpart (range 'A', 'B',..'XFD').
4233 ''' Args:
4235 ''' Returns:
4236 ''' a string representation of the column name, in range 'A'..'XFD'
4237 ''' Adapted from a Python function by sundar nataraj
4238 ''' http://stackoverflow.com/questions/23861680/convert-spreadsheet-number-to-column-letter
4240 Dim sCol As String ' Return value
4241 Dim lDiv As Long ' Intermediate result
4244 Try:
4245 sCol = ""
4246 lDiv = plColumnNumber
4250 lDiv = (lDiv - lMod) \ 26
4251 Loop
4253 Finally:
4254 _GetColumnName = sCol
4255 End Function ' SFDocuments.SF_Calc._GetColumnName
4257 REM -----------------------------------------------------------------------------
4258 Private Function _IsStillAlive(Optional ByVal pbForUpdate As Boolean _
4259 , Optional ByVal pbError As Boolean _
4260 ) As Boolean
4261 ''' Returns True if the document has not been closed manually or incidentally since the last use
4262 ''' If dead the actual instance is disposed. The execution is cancelled when pbError = True (default)
4263 ''' Args:
4264 ''' pbForUpdate: if True (default = False), check additionally if document is open for editing
4265 ''' pbError: if True (default), raise a fatal error
4267 Dim bAlive As Boolean ' Return value
4269 If IsMissing(pbForUpdate) Then pbForUpdate = False
4270 If IsMissing(pbError) Then pbError = True
4272 Try:
4273 bAlive = [_Super]._IsStillAlive(pbForUpdate, pbError)
4275 Finally:
4276 _IsStillAlive = bAlive
4277 Exit Function
4278 End Function ' SFDocuments.SF_Calc._IsStillAlive
4280 REM -----------------------------------------------------------------------------
4281 Private Function _LastCell(ByRef poSheet As Object) As Variant
4282 ''' Returns in an array the coordinates of the last used cell in the given sheet
4284 Dim oCursor As Object ' Cursor on the cell
4285 Dim oRange As Object ' The used range
4288 Try:
4290 oCursor.gotoEndOfUsedArea(True)
4291 Set oRange = poSheet.getCellRangeByName(oCursor.AbsoluteName)
4296 Finally:
4297 _LastCell = vCoordinates
4298 End Function ' SFDocuments.SF_Calc._LastCell
4300 REM -----------------------------------------------------------------------------
4301 Public Function _Offset(ByRef pvRange As Variant _
4302 , ByVal plRows As Long _
4303 , ByVal plColumns As Long _
4304 , ByVal plHeight As Long _
4305 , ByVal plWidth As Long _
4306 ) As Object
4307 ''' Returns a new range offset by a certain number of rows and columns from a given range
4308 ''' Args:
4309 ''' pvRange : the range, as a string or an object, from which the function searches for the new range
4310 ''' plRows : the number of rows by which the reference was corrected up (negative value) or down.
4311 ''' plColumns : the number of columns by which the reference was corrected to the left (negative value) or to the right.
4312 ''' plHeight : the vertical height for an area that starts at the new reference position.
4313 ''' plWidth : the horizontal width for an area that starts at the new reference position.
4314 ''' Arguments Rows and Columns must not lead to zero or negative start row or column.
4315 ''' Arguments Height and Width must not lead to zero or negative count of rows or columns.
4316 ''' Returns:
4317 ''' A new range as object of type _Address
4318 ''' Exceptions:
4319 ''' OFFSETADDRESSERROR The computed range of cells falls beyond the sheet boundaries
4321 Dim oOffset As Object ' Return value
4322 Dim oAddress As Object ' Alias of Range
4323 Dim oSheet As Object ' com.sun.star.sheet.XSpreadsheet
4324 Dim oRange As Object ' com.sun.star.table.XCellRange
4325 Dim oNewRange As Object ' com.sun.star.table.XCellRange
4326 Dim lLeft As Long ' New range coordinates
4327 Dim lTop As Long
4328 Dim lRight As Long
4329 Dim lBottom As Long
4331 Set oOffset = Nothing
4333 Check:
4336 Try:
4337 If VarType(pvRange) = V_STRING Then Set oAddress = _ParseAddress(pvRange) Else Set oAddress = pvRange
4338 Set oSheet = oAddress.XSpreadSheet
4339 Set oRange = oAddress.XCellRange.RangeAddress
4342 ' Compute and validate new coordinates
4343 With oRange
4344 lLeft = .StartColumn + plColumns
4345 lTop = .StartRow + plRows
4351 Then GoTo CatchAddress
4352 Set oNewRange = oSheet.getCellRangeByPosition(lLeft, lTop, lRight, lBottom)
4353 End With
4355 ' Define the new range address
4356 Set oOffset = New _Address
4357 With oOffset
4358 .ObjectType = CALCREFERENCE
4359 .ServiceName = SERVICEREFERENCE
4360 .RawAddress = oNewRange.AbsoluteName
4361 .Component = _Component
4362 .XSpreadsheet = oNewRange.Spreadsheet
4363 .SheetName = .XSpreadsheet.Name
4364 .SheetIndex = .XSpreadsheet.RangeAddress.Sheet
4365 .RangeName = .RawAddress
4366 .XCellRange = oNewRange
4367 .Height = oNewRange.RangeAddress.EndRow - oNewRange.RangeAddress.StartRow + 1
4368 .Width = oNewRange.RangeAddress.EndColumn - oNewRange.RangeAddress.StartColumn + 1
4369 End With
4371 Finally:
4372 Set _Offset = oOffset
4373 Exit Function
4374 Catch:
4375 GoTo Finally
4376 CatchAddress:
4377 ScriptForge.SF_Exception.RaiseFatal(OFFSETADDRESSERROR, "Range", oAddress.RawAddress _
4378 , "Rows", plRows, "Columns", plColumns, "Height", plHeight, "Width", plWidth _
4380 GoTo Finally
4381 End Function ' SFDocuments.SF_Calc._Offset
4383 REM -----------------------------------------------------------------------------
4384 Private Function _ParseAddress(ByVal psAddress As String) As Object
4385 ''' Parse and validate a sheet or range reference
4386 ''' Syntax to parse:
4387 ''' [Sheet].[Range]
4389 ''' Range => A1:D10, A1, A:D, 10:10 ($ ignored), or sheet named range or ~ or *
4390 ''' Returns:
4391 ''' An object of type _Address
4392 ''' Exceptions:
4395 Dim oAddress As Object ' Return value
4396 Dim sAddress As String ' Alias of psAddress
4397 Dim vRangeName As Variant ' Array Sheet/Range
4398 Dim lStart As Long ' Position of found regex
4399 Dim sSheet As String ' Sheet component
4400 Dim sRange As String ' Range component
4401 Dim oSheets As Object ' com.sun.star.sheet.XSpreadsheets
4402 Dim oNamedRanges As Object ' com.sun.star.sheet.XNamedRanges
4403 Dim oRangeAddress As Object ' Alias for rangeaddress
4404 Dim vLastCell As Variant ' Result of _LastCell() method
4405 Dim oSelect As Object ' Current selection
4407 ' If psAddress has already been parsed, get the result back
4408 If Not IsNull(_LastParsedAddress) Then
4409 ' Given argument must contain an explicit reference to a sheet
4410 If (InStr(psAddress, "~.") = 0 And InStr(psAddress, ".") > 0 And psAddress = _LastParsedAddress.RawAddress) _
4411 Or psAddress = _LastParsedAddress.RangeName Then
4412 Set _ParseAddress = _LastParsedAddress
4413 Exit Function
4414 Else
4415 Set _LastParsedAddress = Nothing
4416 End If
4417 End If
4419 ' Reinitialize a new _Address object
4420 Set oAddress = New _Address
4421 With oAddress
4425 .ObjectType = CALCREFERENCE
4426 .ServiceName = SERVICEREFERENCE
4427 .RawAddress = psAddress
4428 Set .XSpreadSheet = Nothing : Set .XCellRange = Nothing
4431 If Left(psAddress, 2) = "$'" Then sAddress = Mid(psAddress, 2) Else sAddress = psAddress
4432 ' Split in sheet and range components on dot not enclosed in single quotes
4433 vRangeName = ScriptForge.SF_String.SplitNotQuoted(sAddress, Delimiter := ".", QuoteChar := "'")
4434 sSheet = ScriptForge.SF_String.Unquote(Replace(vRangeName(0), "''", "\'"), QuoteChar := "'")
4436 ' Notes:
4437 ' sheet names may contain "$" (even "$" is a valid sheet name), named ranges must not
4438 ' sheet names may contain apostrophes (except in 1st and last positions), range names must not
4439 If Left(vRangeName(0), 2) <> "'$" And Left(sSheet, 1) = "$" And Len(sSheet) > 1 Then sSheet = Mid(sSheet, 2)
4442 ' Resolve sheet part: either a document named range, or the active sheet or a real sheet
4443 Set oSheets = _Component.getSheets()
4444 Set oNamedRanges = _Component.NamedRanges
4445 If oSheets.hasByName(sSheet) Then
4447 sSheet = _Component.CurrentController.ActiveSheet.Name
4448 ElseIf oNamedRanges.hasByName(sSheet) Then
4449 .XCellRange = oNamedRanges.getByName(sSheet).ReferredCells
4450 sSheet = oSheets.getByIndex(oNamedRanges.getByName(sSheet).ReferencePosition.Sheet).Name
4451 Else
4452 sRange = sSheet
4453 sSheet = _Component.CurrentController.ActiveSheet.Name
4454 End If
4455 .SheetName = sSheet
4456 .XSpreadSheet = oSheets.getByName(sSheet)
4457 .SheetIndex = .XSpreadSheet.RangeAddress.Sheet
4459 ' Resolve range part - either a sheet named range or the current selection or a real range or ""
4460 If IsNull(.XCellRange) Then
4461 Set oNamedRanges = .XSpreadSheet.NamedRanges
4463 Set oSelect = _Component.CurrentController.getSelection()
4464 If oSelect.supportsService("com.sun.star.sheet.SheetCellRanges") Then ' Multiple selections
4465 Set .XCellRange = oSelect.getByIndex(0)
4466 Else
4467 Set .XCellRange = oSelect
4468 End If
4470 vLastCell = _LastCell(.XSpreadSheet)
4472 Set .XCellRange = .XSpreadSheet.getCellRangeByName(sRange)
4473 ElseIf oNamedRanges.hasByName(sRange) Then
4474 .XCellRange = oNamedRanges.getByName(sRange).ReferredCells
4475 Else
4476 On Local Error GoTo CatchError
4477 Set .XCellRange = .XSpreadSheet.getCellRangeByName(sRange)
4478 ' If range reaches the limits of the sheets, reduce it up to the used area
4479 Set oRangeAddress = .XCellRange.RangeAddress
4481 vLastCell = _LastCell(.XSpreadSheet)
4484 Set .XCellRange = .XSpreadSheet.getCellRangeByName(sRange)
4486 vLastCell = _LastCell(.XSpreadSheet)
4487 sRange = _GetColumnName(oRangeAddress.StartColumn + 1) & "1" & ":" _
4489 Set .XCellRange = .XSpreadSheet.getCellRangeByName(sRange)
4490 End If
4491 End If
4492 End If
4493 If IsNull(.XCellRange) Then GoTo CatchAddress
4495 Set oRangeAddress = .XCellRange.RangeAddress
4496 .RangeName = .XCellRange.AbsoluteName
4497 .Height = oRangeAddress.EndRow - oRangeAddress.StartRow + 1
4498 .Width = oRangeAddress.EndColumn - oRangeAddress.StartColumn + 1
4500 ' Remember the current component in case of use outside the current instance
4501 Set .Component = _Component
4503 End With
4505 ' Store last parsed address for reuse
4506 Set _LastParsedAddress = oAddress
4508 Finally:
4509 Set _ParseAddress = oAddress
4510 Exit Function
4511 CatchError:
4512 ScriptForge.SF_Exception.Clear()
4513 CatchAddress:
4516 GoTo Finally
4517 End Function ' SFDocuments.SF_Calc._ParseAddress
4519 REM -----------------------------------------------------------------------------
4520 Private Function _PropertyGet(Optional ByVal psProperty As String _
4521 , Optional ByVal pvArg As Variant _
4522 ) As Variant
4523 ''' Return the value of the named property
4524 ''' Args:
4525 ''' psProperty: the name of the property
4527 Dim oProperties As Object ' Document or Custom properties
4528 Dim vLastCell As Variant ' Coordinates of last used cell in a sheet
4529 Dim oSelect As Object ' Current selection
4530 Dim vRanges As Variant ' List of selected ranges
4531 Dim oAddress As Object ' _Address type for range description
4532 Dim oCursor As Object ' com.sun.star.sheet.XSheetCellCursor
4533 Dim i As Long
4534 Dim cstThisSub As String
4535 Const cstSubArgs = ""
4537 _PropertyGet = False
4540 ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs)
4541 If Not _IsStillAlive() Then GoTo Finally
4543 Select Case UCase(psProperty)
4545 Set oSelect = _Component.CurrentController.getSelection()
4546 If IsNull(oSelect) Then
4547 _PropertyGet = Array()
4548 ElseIf oSelect.supportsService("com.sun.star.sheet.SheetCellRanges") Then ' Multiple selections
4549 vRanges = Array()
4551 vRanges = ScriptForge.SF_Array.Append(vRanges, oSelect.getByIndex(i).AbsoluteName)
4552 Next i
4553 _PropertyGet = vRanges
4554 Else
4555 _PropertyGet = oSelect.AbsoluteName
4556 End If
4558 If IsMissing(pvArg) Or IsEmpty(pvArg) Then
4559 _PropertyGet = 0
4560 Else
4562 _PropertyGet = _ParseAddress(pvArg).Height
4563 End If
4564 Case UCase("FirstCell"), UCase("FirstRow"), UCase("FirstColumn") _
4567 If IsMissing(pvArg) Or IsEmpty(pvArg) Then ' Avoid errors when instance is watched in Basic IDE
4568 If InStr(UCase(psProperty), "CELL") > 0 Then _PropertyGet = "" Else _PropertyGet = -1
4569 Else
4571 Set oAddress = _ParseAddress(pvArg)
4572 With oAddress.XCellRange
4573 Select Case UCase(psProperty)
4575 _PropertyGet = A1Style(.RangeAddress.StartRow + 1, .RangeAddress.StartColumn + 1, , , oAddress.XSpreadsheet.Name)
4579 _PropertyGet = A1Style(.RangeAddress.EndRow + 1, .RangeAddress.EndColumn + 1, , , oAddress.XSpreadsheet.Name)
4583 End Select
4584 End With
4585 End If
4587 If IsMissing(pvArg) Or IsEmpty(pvArg) Then
4588 Set _PropertyGet = Nothing
4589 Else
4591 Set _PropertyGet = _ParseAddress(pvArg)
4592 End If
4594 If IsMissing(pvArg) Or IsEmpty(pvArg) Then
4595 _PropertyGet = ""
4596 Else
4598 Set oAddress = _ParseAddress(pvArg)
4599 With oAddress
4600 Set oCursor = .XSpreadsheet.createCursorByRange(.XCellRange)
4601 oCursor.collapseToCurrentRegion()
4602 _PropertyGet = oCursor.AbsoluteName
4603 End With
4604 End If
4606 If IsMissing(pvArg) Or IsEmpty(pvArg) Then
4607 Set _PropertyGet = Nothing
4608 Else
4610 Set _PropertyGet = _ParseAddress(pvArg)
4611 End If
4613 _PropertyGet = _Component.getSheets.getElementNames()
4615 If IsMissing(pvArg) Or IsEmpty(pvArg) Then
4616 _PropertyGet = 0
4617 Else
4619 _PropertyGet = _ParseAddress(pvArg).Width
4620 End If
4622 If IsMissing(pvArg) Or IsEmpty(pvArg) Then
4623 Set _PropertyGet = Nothing
4624 Else
4626 Set _PropertyGet = _ParseAddress(pvArg).XCellRange
4627 End If
4629 If IsMissing(pvArg) Or IsEmpty(pvArg) Then
4630 Set _PropertyGet = Nothing
4631 Else
4633 Set oAddress = _ParseAddress(pvArg)
4634 Set _PropertyGet = oAddress.XSpreadsheet.createCursorByRange(oAddress.XCellRange)
4635 End If
4637 If IsMissing(pvArg) Or IsEmpty(pvArg) Then
4638 Set _PropertyGet = Nothing
4639 Else
4641 Set _PropertyGet = _Component.getSheets.getByName(pvArg)
4642 End If
4643 Case Else
4644 _PropertyGet = Null
4645 End Select
4647 Finally:
4648 ScriptForge.SF_Utils._ExitFunction(cstThisSub)
4649 Exit Function
4650 End Function ' SFDocuments.SF_Calc._PropertyGet
4652 REM -----------------------------------------------------------------------------
4653 Private Function _QuoteSheetName(ByVal psSheetName As String) As String
4654 ''' Return the given sheet name surrounded with single quotes
4655 ''' when required to insert the sheet name into a Calc formula
4656 ''' Enclosed single quotes are doubled
4657 ''' Args:
4658 ''' psSheetName: the name to quote
4659 ''' Returns:
4660 ''' The quoted or unchanged sheet name
4662 Dim sSheetName As String ' Return value
4663 Dim i As Long
4665 Try:
4666 ' Surround the sheet name with single quotes when required by the presence of single quotes
4668 sSheetName = "'" & Replace(psSheetName, "'", "''") & "'"
4669 Else
4670 ' Surround the sheet name with single quotes when required by the presence of at least one of the special characters
4671 sSheetName = psSheetName
4672 For i = 1 To Len(cstSPECIALCHARS)
4675 Exit For
4676 End If
4677 Next i
4678 End If
4680 Finally:
4681 _QuoteSheetName = sSheetName
4682 Exit Function
4683 End Function ' SFDocuments.SF_Calc._QuoteSheetName
4685 REM -----------------------------------------------------------------------------
4686 Private Function _Repr() As String
4687 ''' Convert the SF_Calc instance to a readable string, typically for debugging purposes (DebugPrint ...)
4688 ''' Args:
4689 ''' Return:
4694 End Function ' SFDocuments.SF_Calc._Repr
4696 REM -----------------------------------------------------------------------------
4697 Private Sub _RestoreSelections(ByRef pvComponent As Variant _
4698 , ByRef pvSelection As Variant _
4699 )
4700 ''' Set the selection to a single or a multiple range
4701 ''' Does not work well when multiple selections and macro terminating in Basic IDE
4702 ''' Called by the CopyToCell and CopyToRange methods
4703 ''' Args:
4704 ''' pvComponent: should work for foreign instances as well
4705 ''' pvSelection: the stored selection done previously by Component.CurrentController.getSelection()
4707 Dim oCellRanges As Object ' com.sun.star.sheet.SheetCellRanges
4708 Dim vRangeAddresses As Variant ' Array of com.sun.star.table.CellRangeAddress
4709 Dim i As Long
4711 Try:
4712 If IsArray(pvSelection) Then
4714 vRangeAddresses = Array()
4715 ReDim vRangeAddresses(0 To UBound(pvSelection))
4716 For i = 0 To UBound(pvSelection)
4717 vRangeAddresses(i) = pvSelection.getByIndex(i).RangeAddress
4718 Next i
4719 oCellRanges.addRangeAddresses(vRangeAddresses, False)
4720 pvComponent.CurrentController.select(oCellRanges)
4721 Else
4722 pvComponent.CurrentController.select(pvSelection)
4723 End If
4725 Finally:
4726 Exit Sub
4727 End Sub ' SFDocuments.SF_Calc._RestoreSelections
4729 REM -----------------------------------------------------------------------------
4730 Private Function _ValidateSheet(Optional ByRef pvSheetName As Variant _
4731 , Optional ByVal psArgName As String _
4732 , Optional ByVal pvNew As Variant _
4733 , Optional ByVal pvActive As Variant _
4734 , Optional ByVal pvOptional as Variant _
4735 , Optional ByVal pvNumeric As Variant _
4736 , Optional ByVal pvReference As Variant _
4737 , Optional ByVal pvResetSheet As Variant _
4738 ) As Boolean
4739 ''' Sheet designation validation function similar to the SF_Utils._ValidateXXX functions
4740 ''' Args:
4741 ''' pvSheetName: string or numeric position
4742 ''' pvArgName: the name of the variable to be used in the error message
4743 ''' pvNew: if True, sheet must not exist (default = False)
4745 ''' pvOptional: if True, a zero-length string is accepted (default = False)
4746 ''' pvNumeric: if True, the sheet position is accepted (default = False)
4747 ''' pvReference: if True, a sheet reference is acceptable (default = False)
4748 ''' pvNumeric and pvReference must not both be = True
4749 ''' pvResetSheet: if True, return in pvSheetName the correct (case-sensitive) sheet name (default = False)
4750 ''' Returns
4752 ''' Exceptions
4753 ''' DUPLICATESHEETERROR A sheet with the given name exists already
4755 Dim vSheets As Variant ' List of sheets
4756 Dim lSheet As Long ' Index in list of sheets
4757 Dim vTypes As Variant ' Array of accepted variable types
4758 Dim bValid As Boolean ' Return value
4760 Check:
4761 If IsMissing(pvNew) Or IsEmpty(pvNew) Then pvNew = False
4762 If IsMissing(pvActive) Or IsEmpty(pvActive) Then pvActive = False
4763 If IsMissing(pvOptional) Or IsEmpty(pvOptional) Then pvOptional = False
4764 If IsMissing(pvNumeric) Or IsEmpty(pvNumeric) Then pvNumeric = False
4765 If IsMissing(pvReference) Or IsEmpty(pvReference) Then pvReference = False
4766 If IsMissing(pvResetSheet) Or IsEmpty(pvResetSheet) Then pvResetSheet = False
4768 ' Define the acceptable variable types
4769 If pvNumeric Then
4770 vTypes = Array(V_STRING, V_NUMERIC)
4771 ElseIf pvReference Then
4772 vTypes = Array(V_STRING, ScriptForge.V_OBJECT)
4773 Else
4774 vTypes = V_STRING
4775 End If
4776 If Not ScriptForge.SF_Utils._Validate(pvSheetName, psArgName, vTypes, , , Iif(pvReference, CALCREFERENCE, "")) Then GoTo Finally
4777 bValid = False
4779 Try:
4780 If VarType(pvSheetName) = V_STRING Then
4781 If pvOptional And Len(pvSheetName) = 0 Then
4783 pvSheetName = _Component.CurrentController.ActiveSheet.Name
4784 Else
4785 vSheets = _Component.getSheets.getElementNames()
4786 If pvNew Then
4788 If ScriptForge.SF_Array.Contains(vSheets, pvSheetName) Then GoTo CatchDuplicate
4789 Else
4790 If Not ScriptForge.SF_Utils._Validate(pvSheetName, psArgName, V_STRING, vSheets) Then GoTo Finally
4791 If pvResetSheet Then
4792 lSheet = ScriptForge.SF_Array.IndexOf(vSheets, pvSheetName, CaseSensitive := False)
4793 pvSheetName = vSheets(lSheet)
4794 End If
4795 End If
4796 End If
4797 End If
4798 bValid = True
4800 Finally:
4801 _ValidateSheet = bValid
4802 Exit Function
4803 CatchDuplicate:
4804 ScriptForge.SF_Exception.RaiseFatal(DUPLICATESHEETERROR, psArgName, pvSheetName, "Document", [_Super]._FileIdent())
4805 GoTo Finally
4806 End Function ' SFDocuments.SF_Calc._ValidateSheet
4808 REM -----------------------------------------------------------------------------
4809 Private Function _ValidateSheetName(ByRef psSheetName As String _
4810 , ByVal psArgName As String _
4811 ) As Boolean
4812 ''' Check the validity of the sheet name:
4813 ''' A sheet name - must not be empty
4814 ''' - must not contain next characters: []*?:/\
4816 ''' Args:
4817 ''' psSheetName: the name to check
4818 ''' psArgName: the name of the argument to appear in error messages
4819 ''' Returns:
4820 ''' True when the sheet name is valid
4821 ''' Exceptions:
4824 Dim bValid As Boolean ' Return value
4826 Try:
4828 If bValid Then bValid = ( Left(psSheetName, 1) <> "'" And Right(psSheetName, 1) <> "'" )
4829 If bValid Then bValid = ( Len(ScriptForge.SF_String.FindRegex(psSheetName, "^[^\[\]*?:\/\\]+$", 1, CaseSensitive := False)) > 0 )
4830 If Not bValid Then GoTo CatchSheet
4832 Finally:
4833 _ValidateSheetName = bValid
4834 Exit Function
4835 CatchSheet:
4836 ScriptForge.SF_Exception.RaiseFatal(CALCADDRESSERROR, psArgName, psSheetName _
4838 GoTo Finally
4839 End Function ' SFDocuments.SF_Calc._ValidateSheetName
4841 REM ============================================ END OF SFDOCUMENTS.SF_CALC
4842 </script:module>