| blob | 0733be07eb6ae61ff2f6600db44d19d68498eefc |
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 '''
33 ''' The current module is closely related to the "UI" service of the ScriptForge library
34 '''
35 ''' Service invocation examples:
37 ''' Dim ui As Object, oDoc As Object
42 ''' Dim oDoc As Object
43 ''' Set oDoc = CreateScriptService("SFDocuments.Calc", "Untitled 1") ' Default = ActiveWindow
44 ''' ' or Set oDoc = CreateScriptService("SFDocuments.Calc", "Untitled 1") ' Untitled 1 is presumed a Calc document
46 '''
47 ''' Definitions:
48 '''
49 ''' Many methods require a "Sheet" or a "Range" as argument. (NB: a single cell is considered as a special case of a Range)
50 ''' Usually, within a specific Calc instance, sheets and ranges are given as a string: "SheetX" and "D2:F6"
51 ''' Multiple ranges are not supported in this context.
52 ''' Additionally, the .Sheet and .Range methods return a reference that may be used
53 ''' as argument of a method called from another instance of the Calc service
54 ''' Example:
55 ''' Dim oDocA As Object : Set oDocA = ui.OpenDocument("C:\FileA.ods", Hidden := True, ReadOnly := True)
57 ''' oDocB.CopyToRange(oDocA.Range("SheetX.D4:F8"), "D2:F6") ' CopyToRange(source, target)
58 '''
59 ''' Sheet: the sheet name as a string or an object produced by .Sheet()
61 ''' Range: a string designating a set of contiguous cells located in a sheet of the current instance
63 ''' or an object produced by .Range()
64 ''' The sheet name is optional (default = active sheet). Surrounding quotes and $ signs are optional
65 ''' ~.~, ~ The current selection in the active sheet
68 ''' '$SheetX'.A:A or 3:5 All cells in the same column or row up to the last active cell
69 ''' SheetX.* All cells up to the last active cell
70 ''' myRange A range name at spreadsheet level
71 ''' ~.yourRange, SheetX.someRange A range name at sheet level
73 ''' A range within the sheet SheetX in file associated with the myDoc Calc instance
74 '''
76 ''' A FilterFormula may be associated with a FilterScope: "row", "column" or "cell".
77 ''' These arguments determines on which rows/columns/cells of a range the method should be applied
78 ''' Examples:
79 ''' oDoc.ClearAll("A1:J10", FilterFormula := "=(A1<=0)", FilterScope := "CELL") ' Clear all negative values
80 ''' oDoc.ClearAll("A2:J10", FilterFormula := "=(A2<>A1)", FilterScope := "COLUMN") ' Clear when identical to above cell
81 '''
82 ''' FilterFormula: a Calc formula that returns TRUE or FALSE
83 ''' the formula is expressed in terms of
87 ''' relative and absolute references will be interpreted correctly
88 ''' FilterScope: the way the formula is applied, once by row, by column, or by individual cell
89 '''
90 ''' Detailed user documentation:
91 ''' https://help.libreoffice.org/latest/en-US/text/sbasic/shared/03/sf_calc.html?DbPAR=BASIC
92 '''
93 '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
95 REM ================================================================== EXCEPTIONS
106 REM ============================================================= PRIVATE MEMBERS
108 Private [Me] As Object
109 Private [_Super] As Object ' Document superclass, which the current instance is a subclass of
110 Private ObjectType As String ' Must be CALC
111 Private ServiceName As String
113 ' Window component
114 Private _Component As Object ' com.sun.star.lang.XComponent
116 Type _Address
119 RawAddress As String
120 Component As Object ' com.sun.star.lang.XComponent
121 SheetName As String
122 SheetIndex As Integer
123 RangeName As String
124 Height As Long
125 Width As Long
126 XSpreadSheet As Object ' com.sun.star.sheet.XSpreadsheet
127 XCellRange As Object ' com.sun.star.table.XCellRange
128 End Type
130 Private _LastParsedAddress As Object ' _Address type - parsed ranges are cached
132 REM ============================================================ MODULE CONSTANTS
134 Private Const cstSHEET = 1
135 Private Const cstRANGE = 2
142 ' Service name of _Address (used in Python)
147 ' Presence of a special character forces surrounding the sheet name with single quotes in absolute addresses
150 REM ====================================================== CONSTRUCTOR/DESTRUCTOR
152 REM -----------------------------------------------------------------------------
153 Private Sub Class_Initialize()
154 Set [Me] = Nothing
155 Set [_Super] = Nothing
158 Set _Component = Nothing
159 Set _LastParsedAddress = Nothing
160 End Sub ' SFDocuments.SF_Calc Constructor
162 REM -----------------------------------------------------------------------------
163 Private Sub Class_Terminate()
164 Call Class_Initialize()
165 End Sub ' SFDocuments.SF_Calc Destructor
167 REM -----------------------------------------------------------------------------
168 Public Function Dispose() As Variant
169 If Not IsNull([_Super]) Then Set [_Super] = [_Super].Dispose()
170 Call Class_Terminate()
171 Set Dispose = Nothing
172 End Function ' SFDocuments.SF_Calc Explicit Destructor
174 REM ================================================================== PROPERTIES
176 REM -----------------------------------------------------------------------------
177 Property Get CurrentSelection() As Variant
178 ''' Returns as a string the currently selected range or as an array the list of the currently selected ranges
180 End Property ' SFDocuments.SF_Calc.CurrentSelection (get)
182 REM -----------------------------------------------------------------------------
183 Property Let CurrentSelection(Optional ByVal pvSelection As Variant)
184 ''' Set the selection to a single or a multiple range
185 ''' The argument is a string or an array of strings
187 Dim sRange As String ' A single selection
188 Dim oCellRanges As Object ' com.sun.star.sheet.SheetCellRanges
189 Dim vRangeAddresses As Variant ' Array of com.sun.star.table.CellRangeAddress
190 Dim i As Long
194 On Local Error GoTo Catch
196 Check:
197 If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
198 If Not _IsStillAlive(True) Then GoTo Finally
199 If IsArray(pvSelection) Then
200 If Not ScriptForge.SF_Utils._ValidateArray(pvSelection, "pvSelection", 1, V_STRING, True) Then GoTo Finally
201 Else
202 If Not ScriptForge.SF_Utils._Validate(pvSelection, "pvSelection", V_STRING) Then GoTo Finally
203 End If
204 End If
206 Try:
207 If IsArray(pvSelection) Then
209 vRangeAddresses = Array()
210 ReDim vRangeAddresses(0 To UBound(pvSelection))
211 For i = 0 To UBound(pvSelection)
212 vRangeAddresses(i) = Range(pvSelection(i)).XCellRange.RangeAddress
213 Next i
214 oCellRanges.addRangeAddresses(vRangeAddresses, False)
215 _Component.CurrentController.select(oCellRanges)
216 Else
217 _Component.CurrentController.select(_ParseAddress(pvSelection).XCellRange)
218 End If
220 Finally:
221 ScriptForge.SF_Utils._ExitFunction(cstThisSub)
222 Exit Property
223 Catch:
224 GoTo Finally
225 End Property ' SFDocuments.SF_Calc.CurrentSelection (let)
227 REM -----------------------------------------------------------------------------
228 Property Get FirstCell(Optional ByVal RangeName As Variant) As String
229 ''' Returns the First used cell in a given range or sheet
230 ''' When the argument is a sheet it will always return the "sheet.$A$1" cell
232 End Property ' SFDocuments.SF_Calc.FirstCell
234 REM -----------------------------------------------------------------------------
235 Property Get FirstColumn(Optional ByVal RangeName As Variant) As Long
236 ''' Returns the leftmost column in a given sheet or range
239 End Property ' SFDocuments.SF_Calc.FirstColumn
241 REM -----------------------------------------------------------------------------
242 Property Get FirstRow(Optional ByVal RangeName As Variant) As Long
243 ''' Returns the First used column in a given range
246 End Property ' SFDocuments.SF_Calc.FirstRow
248 REM -----------------------------------------------------------------------------
249 Property Get Height(Optional ByVal RangeName As Variant) As Long
250 ''' Returns the height in # of rows of the given range
252 End Property ' SFDocuments.SF_Calc.Height
254 REM -----------------------------------------------------------------------------
255 Property Get LastCell(Optional ByVal RangeName As Variant) As String
256 ''' Returns the last used cell in a given sheet or range
258 End Property ' SFDocuments.SF_Calc.LastCell
260 REM -----------------------------------------------------------------------------
261 Property Get LastColumn(Optional ByVal RangeName As Variant) As Long
262 ''' Returns the last used column in a given sheet
264 End Property ' SFDocuments.SF_Calc.LastColumn
266 REM -----------------------------------------------------------------------------
267 Property Get LastRow(Optional ByVal RangeName As Variant) As Long
268 ''' Returns the last used column in a given sheet
270 End Property ' SFDocuments.SF_Calc.LastRow
272 REM -----------------------------------------------------------------------------
273 Property Get Range(Optional ByVal RangeName As Variant) As Variant
274 ''' Returns a (internal) range object
276 End Property ' SFDocuments.SF_Calc.Range
278 REM -----------------------------------------------------------------------------
279 Property Get Region(Optional ByVal RangeName As Variant) As String
280 ''' Returns the smallest area as a range string that contains the given range
281 ''' and which is completely surrounded with empty cells
283 End Property ' SFDocuments.SF_Calc.Region
285 REM -----------------------------------------------------------------------------
286 Property Get Sheet(Optional ByVal SheetName As Variant) As Variant
287 ''' Returns a (internal) sheet object
289 End Property ' SFDocuments.SF_Calc.Sheet
291 REM -----------------------------------------------------------------------------
292 Property Get SheetName(Optional ByVal RangeName As Variant) As String
293 ''' Returns the sheet name part of a range
295 End Property ' SFDocuments.SF_Calc.SheetName
297 REM -----------------------------------------------------------------------------
298 Property Get Sheets() As Variant
299 ''' Returns an array listing the existing sheet names
301 End Property ' SFDocuments.SF_Calc.Sheets
303 REM -----------------------------------------------------------------------------
304 Property Get Width(Optional ByVal RangeName As Variant) As Long
305 ''' Returns the width in # of columns of the given range
307 End Property ' SFDocuments.SF_Calc.Width
309 REM -----------------------------------------------------------------------------
310 Property Get XCellRange(Optional ByVal RangeName As Variant) As Variant
311 ''' Returns a UNO object of type com.sun.star.Table.CellRange
313 End Property ' SFDocuments.SF_Calc.XCellRange
315 REM -----------------------------------------------------------------------------
316 Property Get XSheetCellCursor(Optional ByVal RangeName As Variant) As Variant
317 ''' Returns a UNO object of type com.sun.star.sheet.XSheetCellCursor
318 '' After having moved the cursor (gotoNext(), ...) the resulting range can be got
319 ''' back as a string with the cursor.AbsoluteName UNO property.
321 End Property ' SFDocuments.SF_Calc.XSheetCellCursor
323 REM -----------------------------------------------------------------------------
324 Property Get XSpreadsheet(Optional ByVal SheetName As Variant) As Variant
325 ''' Returns a UNO object of type com.sun.star.sheet.XSpreadsheet
327 End Property ' SFDocuments.SF_Calc.XSpreadsheet
329 REM ===================================================================== METHODS
331 REM -----------------------------------------------------------------------------
332 Public Function A1Style(Optional ByVal Row1 As Variant _
333 , Optional ByVal Column1 As Variant _
334 , Optional ByVal Row2 As Variant _
335 , Optional ByVal Column2 As Variant _
336 , Optional ByVal SheetName As Variant _
337 ) As String
338 ''' Returns a range expressed in A1-style as defined by its coordinates
339 ''' If only one pair of coordinates is given, the range will embrace only a single cell
340 ''' Args:
341 ''' Row1 : the row number of the first coordinate
342 ''' Column1 : the column number of the first coordinates
343 ''' Row2 : the row number of the second coordinate
344 ''' Column2 : the column number of the second coordinates
345 ''' SheetName: Default = the current sheet. If present, the sheet must exist.
346 ''' Returns:
347 ''' A range as a string
348 ''' Exceptions:
349 ''' Examples:
350 ''' range = oDoc.A1Style(5, 2, 10, 4, "SheetX") ' "'$SheetX'.$E$2:$J$4"
352 Dim sA1Style As String ' Return value
355 Dim i As Long
358 Const cstSubArgs = "Row1, Column1, [Row2], [Column2], [SheetName]="""""
360 If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
361 sA1Style = ""
363 Check:
364 If IsMissing(Row2) Or IsEmpty(Row2) Then Row2 = 0
365 If IsMissing(Column2) Or IsEmpty(Column2) Then Column2 = 0
367 vSheetName = SheetName
369 If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
370 If Not _IsStillAlive() Then GoTo Finally
371 If Not ScriptForge.SF_Utils._Validate(Row1, "Row1", ScriptForge.V_NUMERIC) Then GoTo Finally
372 If Not ScriptForge.SF_Utils._Validate(Column1, "Column1", ScriptForge.V_NUMERIC) Then GoTo Finally
373 If Not ScriptForge.SF_Utils._Validate(Row2, "Row2", ScriptForge.V_NUMERIC) Then GoTo Finally
374 If Not ScriptForge.SF_Utils._Validate(Column2, "Column2", ScriptForge.V_NUMERIC) Then GoTo Finally
375 If Not _ValidateSheet(vSheetName, "SheetName", , True, True, , , True) Then GoTo Finally
376 End If
378 If Row1 > MAXROWS Then Row1 = MAXROWS
379 If Row2 > MAXROWS Then Row2 = MAXROWS
380 If Column1 > MAXCOLS Then Column1 = MAXCOLS
381 If Column2 > MAXCOLS Then Column2 = MAXCOLS
384 lTemp = Row2 : Row2 = Row1 : Row1 = lTemp
385 End If
387 lTemp = Column2 : Column2 = Column1 : Column1 = lTemp
388 End If
390 Try:
391 ' Surround the sheet name with single quotes when required by the presence of special characters
392 vSheetName = _QuoteSheetName(vSheetName)
393 ' Define the new range string
396 & Iif(Row2 > 0 And Column2 > 0, ":$" & _GetColumnName(Column2) & "$" & CLng(Row2), "")
398 Finally:
399 A1Style = sA1Style
400 ScriptForge.SF_Utils._ExitFunction(cstThisSub)
401 Exit Function
402 Catch:
403 GoTo Finally
404 End Function ' SFDocuments.SF_Calc.A1Style
406 REM -----------------------------------------------------------------------------
407 Public Function Activate(Optional ByVal SheetName As Variant) As Boolean
408 ''' Make the current document or the given sheet active
409 ''' Args:
410 ''' SheetName: Default = the Calc document as a whole
411 ''' Returns:
412 ''' True if the document or the sheet could be made active
413 ''' Otherwise, there is no change in the actual user interface
414 ''' Examples:
417 Dim bActive As Boolean ' Return value
418 Dim oSheet As Object ' Reference to sheet
422 If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
423 bActive = False
425 Check:
426 If IsMissing(SheetName) Or IsEmpty(SheetName) Then SheetName = ""
427 If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
428 If Not _IsStillAlive() Then GoTo Finally
430 End If
432 Try:
433 ' Sheet activation, to do only when meaningful, precedes document activation
435 With _Component
436 Set oSheet = .getSheets.getByName(SheetName)
437 Set .CurrentController.ActiveSheet = oSheet
438 End With
439 End If
440 bActive = [_Super].Activate()
442 Finally:
443 Activate = bActive
444 ScriptForge.SF_Utils._ExitFunction(cstThisSub)
445 Exit Function
446 Catch:
447 GoTo Finally
448 End Function ' SFDocuments.SF_Calc.Activate
450 REM -----------------------------------------------------------------------------
451 Public Function Charts(Optional ByVal SheetName As Variant _
452 , Optional ByVal ChartName As Variant _
453 ) As Variant
454 ''' Return either the list of charts present in the given sheet or a chart object
455 ''' Args:
456 ''' SheetName: The name of an existing sheet
457 ''' ChartName: The user-defined name of the targeted chart or the zero-length string
458 ''' Returns:
459 ''' When ChartName = "", return the list of the charts present in the sheet,
460 ''' otherwise, return a new chart service instance
461 ''' Examples:
462 ''' Dim oChart As Object
465 Dim vCharts As Variant ' Return value when array of chart names
466 Dim oChart As Object ' Return value when new chart instance
467 Dim oSheet As Object ' Alias of SheetName as reference
468 Dim oDrawPage As Object ' com.sun.star.drawing.XDrawPage
469 Dim oNextShape As Object ' com.sun.star.drawing.XShape
470 Dim sChartName As String ' Some chart name
471 Dim lCount As Long ' Counter for charts among all drawing objects
472 Dim i As Long
478 If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
479 vCharts = Array()
481 Check:
482 If IsMissing(ChartName) Or IsEmpty(ChartName) Then ChartName = ""
483 If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
484 If Not _IsStillAlive(True) Then GoTo Finally
486 If Not ScriptForge.SF_Utils._Validate(ChartName, "ChartName", V_STRING) Then GoTo Finally
487 End If
489 Try:
490 ' Because the user can change it constantly, the list of valid charts has to be rebuilt at each time
491 ' Explore charts starting from the draw page
492 Set oSheet = _Component.getSheets.getByName(SheetName)
493 Set oDrawPage = oSheet.getDrawPage()
494 vCharts = Array()
495 Set oChart = Nothing
496 lCount = -1
498 Set oNextShape = oDrawPage.getByIndex(i)
499 if oNextShape.supportsService(cstChartShape) Then ' Ignore other shapes
500 sChartName = oNextShape.Name ' User-defined name
502 ' Is chart found ?
504 If ChartName = sChartName Then
505 Set oChart = New SF_Chart
506 With oChart
507 Set .[Me] = oChart
508 Set .[_Parent] = [Me]
509 ._SheetName = SheetName
510 ._DrawIndex = i
511 ._ChartName = ChartName
512 ._PersistentName = oNextShape.PersistName
513 Set ._Shape = oNextShape
514 Set ._Chart = oSheet.getCharts().getByName(._PersistentName)
515 Set ._ChartObject = ._Chart.EmbeddedObject
516 Set ._Diagram = ._ChartObject.Diagram
517 End With
518 Exit For
519 End If
520 End If
521 ' Build stack of chart names
522 lCount = lCount + 1
524 vCharts = Array(sChartName)
525 Else
527 vCharts(lCount) = sChartName
528 End If
529 End If
530 Next i
532 ' Raise error when chart not found
534 If Not ScriptForge.SF_Utils._Validate(ChartName, "ChartName", V_STRING, vCharts) Then GoTo Finally
535 End If
537 Finally:
538 If Len(ChartName) = 0 Then Charts = vCharts Else Set Charts = oChart
539 ScriptForge.SF_Utils._ExitFunction(cstThisSub)
540 Exit Function
541 Catch:
542 GoTo Finally
543 End Function ' SFDocuments.SF_Calc.Charts
545 REM -----------------------------------------------------------------------------
546 Public Sub ClearAll(Optional ByVal Range As Variant _
547 , Optional FilterFormula As Variant _
548 , Optional FilterScope As Variant _
549 )
550 ''' Clear entirely the given range
551 ''' Args:
552 ''' Range : the cell or the range as a string that should be cleared
553 ''' FilterFormula: a Calc formula to select among the given Range
554 ''' When left empty, all the cells of the range are cleared
555 ''' FilterScope: "CELL" (default value), "ROW" or "COLUMN"
556 ''' When FilterFormula is present, FilterScope is mandatory
557 ''' Examples:
559 ''' oDoc.ClearAll("A1:J20", "=($A1=0)", "ROW") ' Clears all rows when 1st cell is zero
563 End Sub ' SFDocuments.SF_Calc.ClearAll
565 REM -----------------------------------------------------------------------------
566 Public Sub ClearFormats(Optional ByVal Range As Variant _
567 , Optional FilterFormula As Variant _
568 , Optional FilterScope As Variant _
569 )
570 ''' Clear all the formatting elements of the given range
571 ''' Args:
572 ''' Range : the cell or the range as a string that should be cleared
573 ''' FilterFormula: a Calc formula to select among the given Range
574 ''' When left empty, all the cells of the range are cleared
575 ''' FilterScope: "CELL" (default value), "ROW" or "COLUMN"
576 ''' When FilterFormula is present, FilterScope is mandatory
577 ''' Examples:
578 ''' oDoc.ClearFormats("SheetX.*") ' Clears the used area of the sheet
579 ''' oDoc.ClearFormats("A1:J20", "=(MOD(A1;0)=0)", "CELL") ' Clears all even cells
583 End Sub ' SFDocuments.SF_Calc.ClearFormats
585 REM -----------------------------------------------------------------------------
586 Public Sub ClearValues(Optional ByVal Range As Variant _
587 , Optional FilterFormula As Variant _
588 , Optional FilterScope As Variant _
589 )
590 ''' Clear values and formulas in the given range
591 ''' Args:
592 ''' Range : the cell or the range as a string that should be cleared
593 ''' FilterFormula: a Calc formula to select among the given Range
594 ''' When left empty, all the cells of the range are cleared
595 ''' FilterScope: "CELL" (default value), "ROW" or "COLUMN"
596 ''' When FilterFormula is present, FilterScope is mandatory
597 ''' Examples:
598 ''' oDoc.ClearValues("SheetX.*") ' Clears the used area of the sheet
599 ''' oDoc.ClearValues("A2:A20", "=(A2=A1)", "CELL") ' Clears all duplicate cells
603 End Sub ' SFDocuments.SF_Calc.ClearValues
605 REM -----------------------------------------------------------------------------
606 Public Function CompactLeft(Optional ByVal Range As Variant _
607 , Optional ByVal WholeColumn As Variant _
608 , Optional ByVal FilterFormula As Variant _
609 ) As String
610 ''' Delete the columns of a specified range matching a filter expressed as a formula
611 ''' applied on each column.
612 ''' The deleted cells can span whole columns or be limited to the height of the range
613 ''' The execution of the method has no effect on the current selection
614 ''' Args:
615 ''' Range: the range in which cells have to be erased, as a string
616 ''' WholeColumn: when True (default = False), erase whole columns
617 ''' FilterFormula: the formula to be applied on each column.
618 ''' The column is erased when the formula results in True,
619 ''' The formula shall probably involve one or more cells of the first column of the range.
620 ''' By default, a column is erased when all the cells of the column are empty,
621 ''' i.e. suppose the range is "A1:J200" (height = 200) the default value becomes
623 ''' Returns:
624 ''' A string representing the location of the initial range after compaction,
625 ''' or the zero-length string if the whole range has been deleted
626 ''' Examples:
627 ''' newrange = oDoc.CompactLeft("SheetX.G1:L10") ' All empty columns of the range are suppressed
628 ''' newrange = oDoc.CompactLeft("SheetX.G1:L10", WholeColumn := True, FilterFormula := "=(G$7=""X"")")
631 Dim sCompact As String ' Return value
632 Dim oCompact As Object ' Return value as an _Address type
633 Dim lCountDeleted As Long ' Count the deleted columns
634 Dim vCompactRanges As Variant ' Array of ranges to be compacted based on the formula
635 Dim oSourceAddress As Object ' Alias of Range as _Address
636 Dim oPartialRange As Object ' Contiguous columns to be deleted
637 Dim sShiftRange As String ' Contiguous columns to be shifted
638 Dim i As Long
641 Const cstSubArgs = "Range, [WholeColumn=False], [FilterFormula=""""]"
643 If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
644 sCompact = ""
646 Check:
647 If IsMissing(WholeColumn) Or IsEmpty(WholeColumn) Then WholeColumn = False
648 If IsMissing(FilterFormula) Or IsEmpty(FilterFormula) Then FilterFormula = ""
649 If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
650 If Not _IsStillAlive(True) Then GoTo Finally
652 If Not ScriptForge.SF_Utils._Validate(WholeColumn, "WholeColumn", ScriptForge.V_BOOLEAN) Then GoTo Finally
653 If Not ScriptForge.SF_Utils._Validate(FilterFormula, "FilterFormula", V_STRING) Then GoTo Finally
654 End If
656 Try:
657 Set oSourceAddress = _ParseAddress(Range)
658 lCountDeleted = 0
660 With oSourceAddress
663 If FilterFormula = "" Then FilterFormula = Printf("=(COUNTBLANK(%C1%R1:%C1%R2)-" & .Height & "=0)", Range)
665 ' Identify the ranges to compact based on the given formula
668 ' Iterate through the ranges from bottom to top and shift them up
670 Set oPartialRange = vCompactRanges(i)
671 ShiftLeft(oPartialRange.RangeName, WholeColumn)
672 lCountDeleted = lCountDeleted + oPartialRange.Width
673 Next i
675 ' Compute the final range position
678 ' Push to the right the cells that migrated leftwards irrelevantly
679 If Not WholeColumn Then
681 sShiftRange = Offset(sCompact, 0, .Width - lCountDeleted, , lCountDeleted)
682 Else
683 sShiftRange = .RangeName
684 End If
685 ShiftRight(sShiftRange, WholeColumn := False)
686 End If
688 End With
690 Finally:
691 CompactLeft = sCompact
692 ScriptForge.SF_Utils._ExitFunction(cstThisSub)
693 Exit Function
694 Catch:
695 ' When error, return the original range
696 If Not IsNull(oSourceAddress) Then sCompact = oSourceAddress.RangeName
697 GoTo Finally
698 End Function ' SFDocuments.SF_Calc.CompactLeft
700 REM -----------------------------------------------------------------------------
701 Public Function CompactUp(Optional ByVal Range As Variant _
702 , Optional ByVal WholeRow As Variant _
703 , Optional ByVal FilterFormula As Variant _
704 ) As String
705 ''' Delete the rows of a specified range matching a filter expressed as a formula
706 ''' applied on each row.
707 ''' The deleted cells can span whole rows or be limited to the width of the range
708 ''' The execution of the method has no effect on the current selection
709 ''' Args:
710 ''' Range: the range in which cells have to be erased, as a string
711 ''' WholeRow: when True (default = False), erase whole rows
712 ''' FilterFormula: the formula to be applied on each row.
713 ''' The row is erased when the formula results in True,
714 ''' The formula shall probably involve one or more cells of the first row of the range.
715 ''' By default, a row is erased when all the cells of the row are empty,
716 ''' i.e. suppose the range is "A1:J200" (width = 10) the default value becomes
718 ''' Returns:
719 ''' A string representing the location of the initial range after compaction,
720 ''' or the zero-length string if the whole range has been deleted
721 ''' Examples:
722 ''' newrange = oDoc.CompactUp("SheetX.G1:L10") ' All empty rows of the range are suppressed
723 ''' newrange = oDoc.CompactUp("SheetX.G1:L10", WholeRow := True, FilterFormula := "=(G1=""X"")")
726 Dim sCompact As String ' Return value
727 Dim oCompact As Object ' Return value as an _Address type
728 Dim lCountDeleted As Long ' Count the deleted rows
729 Dim vCompactRanges As Variant ' Array of ranges to be compacted based on the formula
730 Dim oSourceAddress As Object ' Alias of Range as _Address
731 Dim oPartialRange As Object ' Contiguous rows to be deleted
732 Dim sShiftRange As String ' Contiguous rows to be shifted
733 Dim i As Long
736 Const cstSubArgs = "Range, [WholeRow=False], [FilterFormula=""""]"
738 If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
739 sCompact = ""
741 Check:
742 If IsMissing(WholeRow) Or IsEmpty(WholeRow) Then WholeRow = False
743 If IsMissing(FilterFormula) Or IsEmpty(FilterFormula) Then FilterFormula = ""
744 If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
745 If Not _IsStillAlive(True) Then GoTo Finally
747 If Not ScriptForge.SF_Utils._Validate(WholeRow, "WholeRow", ScriptForge.V_BOOLEAN) Then GoTo Finally
748 If Not ScriptForge.SF_Utils._Validate(FilterFormula, "FilterFormula", V_STRING) Then GoTo Finally
749 End If
751 Try:
752 Set oSourceAddress = _ParseAddress(Range)
753 lCountDeleted = 0
755 With oSourceAddress
758 If FilterFormula = "" Then FilterFormula = Printf("=(COUNTBLANK(%C1%R1:%C2%R1)-" & .Width & "=0)", Range)
760 ' Identify the ranges to compact based on the given formula
763 ' Iterate through the ranges from bottom to top and shift them up
765 Set oPartialRange = vCompactRanges(i)
766 ShiftUp(oPartialRange.RangeName, WholeRow)
767 lCountDeleted = lCountDeleted + oPartialRange.Height
768 Next i
770 ' Compute the final range position
773 ' Push downwards the cells that migrated upwards irrelevantly
774 If Not WholeRow Then
776 sShiftRange = Offset(sCompact, .Height - lCountDeleted, 0, lCountDeleted)
777 Else
778 sShiftRange = .RangeName
779 End If
780 ShiftDown(sShiftRange, WholeRow := False)
781 End If
783 End With
785 Finally:
786 CompactUp = sCompact
787 ScriptForge.SF_Utils._ExitFunction(cstThisSub)
788 Exit Function
789 Catch:
790 ' When error, return the original range
791 If Not IsNull(oSourceAddress) Then sCompact = oSourceAddress.RangeName
792 GoTo Finally
793 End Function ' SFDocuments.SF_Calc.CompactUp
795 REM -----------------------------------------------------------------------------
796 Public Function CopySheet(Optional ByVal SheetName As Variant _
797 , Optional ByVal NewName As Variant _
798 , Optional ByVal BeforeSheet As Variant _
799 ) As Boolean
800 ''' Copy a specified sheet before an existing sheet or at the end of the list of sheets
801 ''' The sheet to copy may be inside any open Calc document
802 ''' Args:
803 ''' SheetName: The name of the sheet to copy or its reference
804 ''' NewName: Must not exist
805 ''' BeforeSheet: The name (string) or index (numeric, starting from 1) of the sheet before which to insert
806 ''' Returns:
807 ''' True if the sheet could be copied successfully
808 ''' Exceptions:
809 ''' DUPLICATESHEETERROR A sheet with the given name exists already
810 ''' Examples:
812 ''' ' Copy within the same document
813 ''' Dim oDocA As Object : Set oDocA = ui.OpenDocument("C:\Temp\FileA.ods", Hidden := True, ReadOnly := True)
814 ''' Dim oDocB As Object : Set oDocB = ui.OpenDocument("C:\Temp\FileB.ods")
818 Dim bCopy As Boolean ' Return value
819 Dim oSheets As Object ' com.sun.star.sheet.XSpreadsheets
820 Dim vSheets As Variant ' List of existing sheets
821 Dim lSheetIndex As Long ' Index of a sheet
822 Dim oSheet As Object ' Alias of SheetName as reference
823 Dim lRandom As Long ' Output of random number generator
824 Dim sRandom ' Random sheet name
828 If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
829 bCopy = False
831 Check:
832 If IsMissing(BeforeSheet) Or IsEmpty(BeforeSheet) Then BeforeSheet = 32768
833 If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
834 If Not _IsStillAlive(True) Then GoTo Finally
838 End If
840 Try:
841 ' Determine the index of the sheet before which to insert the copy
842 Set oSheets = _Component.getSheets
843 vSheets = oSheets.getElementNames()
844 If VarType(BeforeSheet) = V_STRING Then
845 lSheetIndex = ScriptForge.SF_Array.IndexOf(vSheets, BeforeSheet)
846 Else
847 lSheetIndex = BeforeSheet - 1
850 End If
852 ' Copy sheet inside the same document OR import from another document
853 If VarType(SheetName) = V_STRING Then
854 _Component.getSheets.copyByName(SheetName, NewName, lSheetIndex)
855 Else
856 Set oSheet = SheetName
857 With oSheet
858 ' If a sheet with same name as input exists in the target sheet, rename it first with a random name
859 sRandom = ""
860 If ScriptForge.SF_Array.Contains(vSheets, .SheetName) Then
863 oSheets.getByName(.SheetName).setName(sRandom)
864 End If
865 ' Import i.o. Copy
866 oSheets.importSheet(oSheet.Component, .SheetName, lSheetIndex)
867 ' Rename to new sheet name
868 oSheets.getByName(.SheetName).setName(NewName)
869 ' Reset random name
871 End With
872 End If
873 bCopy = True
875 Finally:
876 CopySheet = bCopy
877 ScriptForge.SF_Utils._ExitFunction(cstThisSub)
878 Exit Function
879 Catch:
880 GoTo Finally
881 CatchDuplicate:
882 ScriptForge.SF_Exception.RaiseFatal(DUPLICATESHEETERROR, "NewName", NewName, "Document", [_Super]._FileIdent())
883 GoTo Finally
884 End Function ' SFDocuments.SF_Calc.CopySheet
886 REM -----------------------------------------------------------------------------
887 Public Function CopySheetFromFile(Optional ByVal FileName As Variant _
888 , Optional ByVal SheetName As Variant _
889 , Optional ByVal NewName As Variant _
890 , Optional ByVal BeforeSheet As Variant _
891 ) As Boolean
892 ''' Copy a specified sheet before an existing sheet or at the end of the list of sheets
893 ''' The sheet to copy is located inside any closed Calc document
894 ''' Args:
895 ''' FileName: Identifies the file to open. It must follow the SF_FileSystem.FileNaming notation
896 ''' The file must not be protected with a password
897 ''' SheetName: The name of the sheet to copy
898 ''' NewName: Must not exist
899 ''' BeforeSheet: The name (string) or index (numeric, starting from 1) of the sheet before which to insert
900 ''' Returns:
901 ''' True if the sheet could be created
902 ''' The created sheet is blank when the input file is not a Calc file
903 ''' The created sheet contains an error message when the input sheet was not found
904 ''' Exceptions:
905 ''' DUPLICATESHEETERROR A sheet with the given name exists already
906 ''' UNKNOWNFILEERROR The input file is unknown
907 ''' Examples:
908 ''' oDoc.CopySheetFromFile("C:\MyFile.ods", "SheetX", "SheetY", 3)
910 Dim bCopy As Boolean ' Return value
911 Dim oSheet As Object ' com.sun.star.sheet.XSpreadsheet
912 Dim sFileName As String ' URL alias of FileName
913 Dim FSO As Object ' SF_FileSystem
915 Const cstSubArgs = "FileName, SheetName, NewName, [BeforeSheet=""""]"
917 If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
918 bCopy = False
920 Check:
921 If IsMissing(BeforeSheet) Or IsEmpty(BeforeSheet) Then BeforeSheet = 32768
922 If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
923 If Not _IsStillAlive(True) Then GoTo Finally
925 If Not ScriptForge.SF_Utils._Validate(SheetName, "SheetName", V_STRING) Then GoTo Finally
928 End If
930 Try:
931 Set FSO = ScriptForge.SF_FileSystem
932 ' Does the input file exist ?
933 If Not FSO.FileExists(FileName) Then GoTo CatchNotExists
934 sFileName = FSO._ConvertToUrl(FileName)
936 ' Insert a blank new sheet and import sheet from file via link setting and deletion
937 If Not InsertSheet(Newname, BeforeSheet) Then GoTo Finally
938 Set oSheet = _Component.getSheets.getByName(NewName)
939 With oSheet
941 .LinkMode = com.sun.star.sheet.SheetLinkMode.NONE
942 .LinkURL = ""
943 End With
944 bCopy = True
946 Finally:
947 CopySheetFromFile = bCopy
948 ScriptForge.SF_Utils._ExitFunction(cstThisSub)
949 Exit Function
950 Catch:
951 GoTo Finally
952 CatchNotExists:
954 GoTo Finally
955 End Function ' SFDocuments.SF_Calc.CopySheetFromFile
957 REM -----------------------------------------------------------------------------
958 Public Function CopyToCell(Optional ByVal SourceRange As Variant _
959 , Optional ByVal DestinationCell As Variant _
960 ) As String
961 ''' Copy a specified source range to a destination range or cell
962 ''' The source range may belong to another open document
963 ''' The method imitates the behaviour of a Copy/Paste from a range to a single cell
964 ''' Args:
965 ''' SourceRange: the source range as a string if it belongs to the same document
966 ''' or as a reference if it belongs to another open Calc document
967 ''' DestinationCell: the destination of the copied range of cells, as a string
968 ''' If given as a range of cells, the destination will be reduced to its top-left cell
969 ''' Returns:
970 ''' A string representing the modified range of cells
971 ''' The modified area depends only on the size of the source area
972 ''' Examples:
974 ''' ' Copy within the same document
975 ''' Dim oDocA As Object : Set oDocA = ui.OpenDocument("C:\Temp\FileA.ods", Hidden := True, ReadOnly := True)
976 ''' Dim oDocB As Object : Set oDocB = ui.OpenDocument("C:\Temp\FileB.ods")
977 ''' oDocB.CopyToCell(oDocA.Range("SheetX.A1:F10"), "SheetY.C5")
980 Dim sCopy As String ' Return value
981 Dim oSource As Object ' Alias of SourceRange to avoid "Object variable not set" run-time error
982 Dim oSourceAddress As Object ' com.sun.star.table.CellRangeAddress
983 Dim oDestRange As Object ' Destination as a range
984 Dim oDestAddress As Object ' com.sun.star.table.CellRangeAddress
985 Dim oDestCell As Object ' com.sun.star.table.CellAddress
986 Dim oSelect As Object ' Current selection in source
987 Dim oClipboard As Object ' com.sun.star.datatransfer.XTransferable
992 If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
993 sCopy = ""
995 Check:
996 If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
997 If Not _IsStillAlive(True) Then GoTo Finally
998 If Not ScriptForge.SF_Utils._Validate(SourceRange, "SourceRange", Array(V_STRING, ScriptForge.V_OBJECT), , , CALCREFERENCE) Then GoTo Finally
999 If Not ScriptForge.SF_Utils._Validate(DestinationCell, "DestinationCell", V_STRING) Then GoTo Finally
1000 End If
1002 Try:
1003 If VarType(SourceRange) = V_STRING Then ' Same document - Use UNO copyRange method
1004 Set oSourceAddress = _ParseAddress(SourceRange).XCellRange.RangeAddress
1005 Set oDestRange = _ParseAddress(DestinationCell)
1006 Set oDestAddress = oDestRange.XCellRange.RangeAddress
1007 Set oDestCell = New com.sun.star.table.CellAddress
1008 With oDestAddress
1009 oDestCell.Sheet = .Sheet
1010 oDestCell.Column = .StartColumn
1011 oDestCell.Row = .StartRow
1012 End With
1013 oDestRange.XSpreadsheet.copyRange(oDestCell, oSourceAddress)
1014 Else ' Use clipboard to copy - current selection in Source should be preserved
1015 Set oSource = SourceRange
1016 With oSource
1017 ' Keep current selection in source document
1018 Set oSelect = .Component.CurrentController.getSelection()
1019 ' Select, copy the source range and paste in the top-left cell of the destination
1020 .Component.CurrentController.select(.XCellRange)
1021 Set oClipboard = .Component.CurrentController.getTransferable()
1023 _Component.CurrentController.insertTransferable(oClipBoard)
1024 ' Restore previous selection in Source
1025 _RestoreSelections(.Component, oSelect)
1026 Set oSourceAddress = .XCellRange.RangeAddress
1027 End With
1028 End If
1030 With oSourceAddress
1031 sCopy = _Offset(DestinationCell, 0, 0, .EndRow - .StartRow + 1, .EndColumn - .StartColumn + 1).RangeName
1032 End With
1034 Finally:
1035 CopyToCell = sCopy
1036 ScriptForge.SF_Utils._ExitFunction(cstThisSub)
1037 Exit Function
1038 Catch:
1039 GoTo Finally
1040 End Function ' SFDocuments.SF_Calc.CopyToCell
1042 REM -----------------------------------------------------------------------------
1043 Public Function CopyToRange(Optional ByVal SourceRange As Variant _
1044 , Optional ByVal DestinationRange As Variant _
1045 ) As String
1046 ''' Copy downwards and/or rightwards a specified source range to a destination range
1047 ''' The source range may belong to another open document
1048 ''' The method imitates the behaviour of a Copy/Paste from a range to a larger range
1049 ''' If the height (resp. width) of the destination area is > 1 row (resp. column)
1050 ''' then the height (resp. width) of the source must be <= the height (resp. width)
1051 ''' of the destination. Otherwise nothing happens
1053 ''' is expanded downwards (resp. rightwards) up to the height (resp. width)
1054 ''' of the source range
1055 ''' Args:
1056 ''' SourceRange: the source range as a string if it belongs to the same document
1057 ''' or as a reference if it belongs to another open Calc document
1058 ''' DestinationRange: the destination of the copied range of cells, as a string
1059 ''' Returns:
1060 ''' A string representing the modified range of cells
1061 ''' Examples:
1063 ''' ' Copy within the same document
1065 ''' Dim oDocA As Object : Set oDocA = ui.OpenDocument("C:\Temp\FileA.ods", Hidden := True, ReadOnly := True)
1066 ''' Dim oDocB As Object : Set oDocB = ui.OpenDocument("C:\Temp\FileB.ods")
1067 ''' oDocB.CopyToRange(oDocA.Range("SheetX.A1:F10"), "SheetY.C5:J5")
1070 Dim sCopy As String ' Return value
1071 Dim oSource As Object ' Alias of SourceRange to avoid "Object variable not set" run-time error
1072 Dim oDestRange As Object ' Destination as a range
1073 Dim oDestCell As Object ' com.sun.star.table.CellAddress
1074 Dim oSelect As Object ' Current selection in source
1075 Dim oClipboard As Object ' com.sun.star.datatransfer.XTransferable
1076 Dim bSameDocument As Boolean ' True when source in same document as destination
1077 Dim lHeight As Long ' Height of destination
1078 Dim lWidth As Long ' Width of destination
1083 If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
1084 sCopy = ""
1086 Check:
1087 If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
1088 If Not _IsStillAlive(True) Then GoTo Finally
1089 If Not ScriptForge.SF_Utils._Validate(SourceRange, "SourceRange", Array(V_STRING, ScriptForge.V_OBJECT), , , CALCREFERENCE) Then GoTo Finally
1090 If Not ScriptForge.SF_Utils._Validate(DestinationRange, "DestinationRange", V_STRING) Then GoTo Finally
1091 End If
1093 Try:
1094 ' Copy done via clipboard
1097 bSameDocument = ( VarType(SourceRange) = V_STRING )
1098 If bSameDocument Then Set oSource = _ParseAddress(SourceRange) Else Set oSource = SourceRange
1099 Set oDestRange = _ParseAddress(DestinationRange)
1100 With oDestRange
1101 lHeight = .Height
1102 lWidth = .Width
1103 If lHeight = 1 Then
1104 lHeight = oSource.Height ' Future height
1105 ElseIf lHeight < oSource.Height Then
1106 GoTo Finally
1107 End If
1108 If lWidth = 1 Then
1109 lWidth = oSource.Width ' Future width
1110 ElseIf lWidth < oSource.Width Then
1111 GoTo Finally
1112 End If
1113 End With
1115 With oSource
1116 ' Store actual selection in source
1117 Set oSelect = .Component.CurrentController.getSelection()
1118 ' Select, copy the source range and paste in the destination
1119 .Component.CurrentController.select(.XCellRange)
1120 Set oClipboard = .Component.CurrentController.getTransferable()
1121 _Component.CurrentController.select(oDestRange.XCellRange)
1122 _Component.CurrentController.insertTransferable(oClipBoard)
1123 ' Restore selection in source
1124 _RestoreSelections(.Component, oSelect)
1125 End With
1129 Finally:
1130 CopyToRange = sCopy
1131 ScriptForge.SF_Utils._ExitFunction(cstThisSub)
1132 Exit Function
1133 Catch:
1134 GoTo Finally
1135 End Function ' SFDocuments.SF_Calc.CopyToRange
1137 REM -----------------------------------------------------------------------------
1138 Public Function CreateChart(Optional ByVal ChartName As Variant _
1139 , Optional ByVal SheetName As Variant _
1140 , Optional ByVal Range As Variant _
1141 , Optional ColumnHeader As Variant _
1142 , Optional RowHeader As Variant _
1143 ) As Variant
1144 ''' Return a new chart instance initialized with default values
1145 ''' Args:
1146 ''' ChartName: The user-defined name of the new chart
1147 ''' SheetName: The name of an existing sheet
1148 ''' Range: the cell or the range as a string that should be drawn
1149 ''' ColumnHeader: when True, the topmost row of the range will be used to set labels for the category axis or the legend.
1150 ''' Default = False
1151 ''' RowHeader: when True, the leftmost column of the range will be used to set labels for the category axis or the legend.
1152 ''' Default = False
1153 ''' Returns:
1154 ''' A new chart service instance
1155 ''' Exceptions:
1156 ''' DUPLICATECHARTERROR A chart with the same name exists already in the given sheet
1157 ''' Examples:
1158 ''' Dim oChart As Object
1159 ''' Set oChart = oDoc.CreateChart("myChart", "SheetX", "A1:C8", ColumnHeader := True)
1161 Dim oChart As Object ' Return value
1162 Dim vCharts As Variant ' List of pre-existing charts
1163 Dim oSheet As Object ' Alias of SheetName as reference
1164 Dim oRange As Object ' Alias of Range
1165 Dim oRectangle as new com.sun.star.awt.Rectangle ' Simple shape
1168 Const cstSubArgs = "ChartName, SheetName, Range, [ColumnHeader=False], [RowHeader=False]"
1170 If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
1171 Set oChart = Nothing
1173 Check:
1174 If IsMissing(RowHeader) Or IsEmpty(RowHeader) Then Rowheader = False
1175 If IsMissing(ColumnHeader) Or IsEmpty(ColumnHeader) Then ColumnHeader = False
1176 If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
1177 If Not _IsStillAlive(True) Then GoTo Finally
1178 If Not ScriptForge.SF_Utils._Validate(ChartName, "ChartName", V_STRING) Then GoTo Finally
1181 If Not ScriptForge.SF_Utils._Validate(ColumnHeader, "ColumnHeader", ScriptForge.V_BOOLEAN) Then GoTo Finally
1182 If Not ScriptForge.SF_Utils._Validate(RowHeader, "RowHeader", ScriptForge.V_BOOLEAN) Then GoTo Finally
1183 End If
1185 vCharts = Charts(SheetName)
1186 If ScriptForge.SF_Array.Contains(vCharts, ChartName, CaseSensitive := True) Then GoTo CatchDuplicate
1188 Try:
1189 ' The rectangular shape receives arbitrary values. User can Resize() it later
1190 With oRectangle
1193 End With
1194 ' Initialize sheet and range
1195 Set oSheet = _Component.getSheets.getByName(SheetName)
1196 Set oRange = _ParseAddress(Range)
1197 ' Create the chart and get ihe corresponding chart instance
1198 oSheet.getCharts.addNewByName(ChartName, oRectangle, Array(oRange.XCellRange.RangeAddress), ColumnHeader, RowHeader)
1199 Set oChart = Charts(SheetName, ChartName)
1200 oChart._Shape.Name = ChartName ' Both user-defined and internal names match ChartName
1201 oChart._Diagram.Wall.FillColor = RGB(255, 255, 255) ' Align on background color set by the user interface by default
1203 Finally:
1204 Set CreateChart = oChart
1205 ScriptForge.SF_Utils._ExitFunction(cstThisSub)
1206 Exit Function
1207 Catch:
1208 GoTo Finally
1209 CatchDuplicate:
1210 ScriptForge.SF_Exception.RaiseFatal(DUPLICATECHARTERROR, "ChartName", ChartName, "SheetName", SheetName, "Document", [_Super]._FileIdent())
1211 GoTo Finally
1212 End Function ' SFDocuments.SF_Calc.CreateChart
1214 REM -----------------------------------------------------------------------------
1215 Public Function CreatePivotTable(Optional ByVal PivotTableName As Variant _
1216 , Optional ByVal SourceRange As Variant _
1217 , Optional ByVal TargetCell As Variant _
1218 , Optional ByRef DataFields As Variant _
1219 , Optional ByRef RowFields As Variant _
1220 , Optional ByRef ColumnFields As Variant _
1221 , Optional ByVal FilterButton As Variant _
1222 , Optional ByVal RowTotals As Variant _
1223 , Optional ByVal ColumnTotals As Variant _
1224 ) As String
1225 ''' Create a new pivot table with the properties defined by the arguments.
1226 ''' If a pivot table with the same name exists already in the targeted sheet, it will be erased without warning.
1227 ''' Args:
1228 ''' PivotTableName: The user-defined name of the new pivottable
1229 ''' SourceRange: The range as a string containing the raw data.
1230 ''' The first row of the range is presumed to contain the field names of the new pivot table
1231 ''' TargetCell: the top left cell or the range as a string where to locate the pivot table.
1232 ''' Only the top left cell of the range will be considered.
1233 ''' DataFields: A single string or an array of field name + function to apply, formatted like:
1235 ''' The allowed functions are: Sum, Count, Average, Max, Min, Product, CountNums, StDev, StDevP, Var, VarP and Median.
1236 ''' The default function is: When the values are all numerical, Sum is used, otherwise Count
1237 ''' RowFields: A single string or an array of the field names heading the pivot table rows
1238 ''' ColumnFields: A single string or an array of the field names heading the pivot table columns
1239 ''' FilterButton: When True (default), display a "Filter" button above the pivot table
1240 ''' RowTotals: When True (default), display a separate column for row totals
1241 ''' ColumnTotals: When True (default), display a separate row for column totals
1242 ''' Returns:
1243 ''' Return the range where the new pivot table is deployed.
1244 ''' Examples:
1245 ''' Dim vData As Variant, oDoc As Object, sTable As String, sPivot As String
1246 ''' vData = Array(Array("Item", "State", "Team", "2002", "2003", "2004"), _
1247 ''' Array("Books", "Michigan", "Jean", 14788, 30222, 23490), _
1248 ''' Array("Candy", "Michigan", "Jean", 26388, 15641, 32849), _
1249 ''' Array("Pens", "Michigan", "Jean", 16569, 32675, 25396), _
1250 ''' Array("Books", "Michigan", "Volker", 21961, 21242, 29009), _
1251 ''' Array("Candy", "Michigan", "Volker", 26142, 22407, 32841))
1254 ''' sPivot = oDoc.CreatePivotTable("PT1", sTable, "H1", Array("2002", "2003;count", "2004;average"), "Item", Array("State", "Team"), False)
1256 Dim sPivotTable As String ' Return value
1257 Dim vData As Variant ' Alias of DataFields
1258 Dim vRows As Variant ' Alias of RowFields
1259 Dim vColumns As Variant ' Alias of ColumnFields
1260 Dim oSourceAddress As Object ' Source as an _Address
1261 Dim oTargetAddress As Object ' Target as an _Address
1262 Dim vHeaders As Variant ' Array of header fields in the source range
1263 Dim oPivotTables As Object ' com.sun.star.sheet.XDataPilotTables
1264 Dim oDescriptor As Object ' com.sun.star.sheet.DataPilotDescriptor
1265 Dim oFields As Object ' ScDataPilotFieldsObj - Collection of fields
1266 Dim oField As Object ' ScDataPilotFieldsObj - A single field
1267 Dim sField As String ' A single field name
1268 Dim sData As String ' A single data field name + function
1269 Dim vDataField As Variant ' A single vData element, split on semicolon
1270 Dim sFunction As String ' Function to apply on a data field (string)
1271 Dim iFunction As Integer ' Equivalent of sFunction as com.sun.star.sheet.GeneralFunction2 constant
1272 Dim oOutputRange As Object ' com.sun.star.table.CellRangeAddress
1273 Dim i As Integer
1276 Const cstSubArgs = "PivotTableName, SourceRange, TargetCell, DataFields, [RowFields], [ColumnFields]" _
1279 If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
1280 sPivotTable = ""
1282 Check:
1283 If IsMissing(RowFields) Or IsEmpty(RowFields) Then RowFields = Array()
1284 If IsMissing(ColumnFields) Or IsEmpty(ColumnFields) Then ColumnFields = Array()
1285 If IsMissing(FilterButton) Or IsEmpty(FilterButton) Then FilterButton = True
1286 If IsMissing(RowTotals) Or IsEmpty(RowTotals) Then RowTotals = True
1287 If IsMissing(ColumnTotals) Or IsEmpty(ColumnTotals) Then ColumnTotals = True
1288 If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
1289 If Not _IsStillAlive(True) Then GoTo Finally
1290 If Not ScriptForge.SF_Utils._Validate(PivotTableName, "PivotTableName", V_STRING) Then GoTo Finally
1291 If Not ScriptForge.SF_Utils._Validate(SourceRange, "SourceRange", V_STRING) Then GoTo Finally
1292 If Not ScriptForge.SF_Utils._Validate(TargetCell, "TargetCell", V_STRING) Then GoTo Finally
1293 If IsArray(DataFields) Then
1294 If Not ScriptForge.SF_Utils._ValidateArray(DataFields, "DataFields", 1, V_STRING, True) Then GoTo Finally
1295 Else
1296 If Not ScriptForge.SF_Utils._Validate(DataFields, "DataFields", V_STRING) Then GoTo Finally
1297 End If
1298 If IsArray(RowFields) Then
1299 If Not ScriptForge.SF_Utils._ValidateArray(RowFields, "RowFields", 1, V_STRING, True) Then GoTo Finally
1300 Else
1301 If Not ScriptForge.SF_Utils._Validate(RowFields, "RowFields", V_STRING) Then GoTo Finally
1302 End If
1303 If IsArray(ColumnFields) Then
1304 If Not ScriptForge.SF_Utils._ValidateArray(ColumnFields, "ColumnFields", 1, V_STRING, True) Then GoTo Finally
1305 Else
1306 If Not ScriptForge.SF_Utils._Validate(ColumnFields, "ColumnFields", V_STRING) Then GoTo Finally
1307 End If
1308 If Not ScriptForge.SF_Utils._Validate(FilterButton, "FilterButton", ScriptForge.V_BOOLEAN) Then GoTo Finally
1309 If Not ScriptForge.SF_Utils._Validate(RowTotals, "RowTotals", ScriptForge.V_BOOLEAN) Then GoTo Finally
1310 If Not ScriptForge.SF_Utils._Validate(ColumnTotals, "ColumnTotals", ScriptForge.V_BOOLEAN) Then GoTo Finally
1311 End If
1312 ' Next statements must be outside previous If-block to force their execution even in case of internal call
1313 If IsArray(DataFields) Then vData = DataFields Else vData = Array(DataFields)
1314 If IsArray(RowFields) Then vRows = RowFields Else vRows = Array(RowFields)
1315 If IsArray(ColumnFields) Then vColumns = ColumnFields Else vColumns = Array(ColumnFields)
1317 Try:
1319 Set oSourceAddress = _ParseAddress(SourceRange)
1320 vHeaders = GetValue(Offset(SourceRange, 0, 0, 1)) ' Content of the first row of the source
1322 Set oPivotTables = oTargetAddress.XSpreadsheet.getDataPilotTables()
1324 ' Initialize new pivot table
1325 Set oDescriptor = oPivotTables.createDataPilotDescriptor()
1326 oDescriptor.setSourceRange(oSourceAddress.XCellRange.RangeAddress)
1327 Set oFields = oDescriptor.getDataPilotFields()
1329 ' Set row fields
1330 For i = 0 To UBound(vRows)
1331 sField = vRows(i)
1333 If Not ScriptForge.SF_Utils._Validate(sField, "RowFields", V_STRING, vHeaders) Then GoTo Finally
1334 Set oField = oFields.getByName(sField)
1335 oField.Orientation = com.sun.star.sheet.DataPilotFieldOrientation.ROW
1336 End If
1337 Next i
1339 ' Set column fields
1340 For i = 0 To UBound(vColumns)
1341 sField = vColumns(i)
1343 If Not ScriptForge.SF_Utils._Validate(sField, "ColumnFields", V_STRING, vHeaders) Then GoTo Finally
1344 Set oField = oFields.getByName(sField)
1345 oField.Orientation = com.sun.star.sheet.DataPilotFieldOrientation.COLUMN
1346 End If
1347 Next i
1349 ' Set data fields
1350 For i = 0 To UBound(vData)
1351 sData = vData(i)
1352 ' Minimal parsing
1355 sField = vDataField(0)
1357 ' Define field properties
1359 If Not ScriptForge.SF_Utils._Validate(sField, "DataFields", V_STRING, vHeaders) Then GoTo Finally
1360 Set oField = oFields.getByName(sField)
1361 oField.Orientation = com.sun.star.sheet.DataPilotFieldOrientation.DATA
1362 ' Associate the correct function
1363 With com.sun.star.sheet.GeneralFunction2
1364 Select Case UCase(sFunction)
1365 Case "" : iFunction = .AUTO
1378 Case Else
1380 , Array("Sum", "Count", "Average", "Max", "Min", "Product", "CountNums" _
1381 , "StDev", "StDevP", "Var", "VarP", "Median") _
1382 ) Then GoTo Finally
1383 End Select
1384 End With
1385 oField.Function2 = iFunction
1386 End If
1387 Next i
1389 ' Remove any pivot table with same name
1390 If oPivotTables.hasByName(PivotTableName) Then oPivotTables.removeByName(PivotTableName)
1392 ' Finalize the new pivot table
1393 oDescriptor.ShowFilterButton = FilterButton
1394 oDescriptor.RowGrand = RowTotals
1395 oDescriptor.ColumnGrand = ColumnTotals
1396 oPivotTables.insertNewByName(PivotTableName, oTargetAddress.XCellRange.getCellByPosition(0, 0).CellAddress, oDescriptor)
1398 ' Determine the range of the new pivot table
1399 Set oOutputRange = oPivotTables.getByName(PivotTableName).OutputRange
1400 With oOutputRange
1401 sPivotTable = _Component.getSheets().getCellRangeByPosition(.StartColumn, .StartRow, .EndColumn, .EndRow, .Sheet).AbsoluteName
1402 End With
1404 Finally:
1405 CreatePivotTable = sPivotTable
1406 ScriptForge.SF_Utils._ExitFunction(cstThisSub)
1407 Exit Function
1408 Catch:
1409 GoTo Finally
1410 End Function ' SFDocuments.SF_Calc.CreatePivotTable
1412 REM -----------------------------------------------------------------------------
1413 Public Function DAvg(Optional ByVal Range As Variant) As Double
1414 ''' Get the average of the numeric values stored in the given range
1415 ''' Args:
1416 ''' Range : the range as a string where to get the values from
1417 ''' Returns:
1418 ''' The average of the numeric values as a double
1419 ''' Examples:
1422 Try:
1425 Finally:
1426 Exit Function
1427 End Function ' SFDocuments.SF_Calc.DAvg
1429 REM -----------------------------------------------------------------------------
1430 Public Function DCount(Optional ByVal Range As Variant) As Long
1431 ''' Get the number of numeric values stored in the given range
1432 ''' Args:
1433 ''' Range : the range as a string where to get the values from
1434 ''' Returns:
1435 ''' The number of numeric values as a Long
1436 ''' Examples:
1439 Try:
1442 Finally:
1443 Exit Function
1444 End Function ' SFDocuments.SF_Calc.DCount
1446 REM -----------------------------------------------------------------------------
1447 Public Function DMax(Optional ByVal Range As Variant) As Double
1448 ''' Get the greatest of the numeric values stored in the given range
1449 ''' Args:
1450 ''' Range : the range as a string where to get the values from
1451 ''' Returns:
1452 ''' The greatest of the numeric values as a double
1453 ''' Examples:
1456 Try:
1459 Finally:
1460 Exit Function
1461 End Function ' SFDocuments.SF_Calc.DMax
1463 REM -----------------------------------------------------------------------------
1464 Public Function DMin(Optional ByVal Range As Variant) As Double
1465 ''' Get the smallest of the numeric values stored in the given range
1466 ''' Args:
1467 ''' Range : the range as a string where to get the values from
1468 ''' Returns:
1469 ''' The smallest of the numeric values as a double
1470 ''' Examples:
1473 Try:
1476 Finally:
1477 Exit Function
1478 End Function ' SFDocuments.SF_Calc.DMin
1480 REM -----------------------------------------------------------------------------
1481 Public Function DSum(Optional ByVal Range As Variant) As Double
1482 ''' Get sum of the numeric values stored in the given range
1483 ''' Args:
1484 ''' Range : the range as a string where to get the values from
1485 ''' Returns:
1486 ''' The sum of the numeric values as a double
1487 ''' Examples:
1490 Try:
1493 Finally:
1494 Exit Function
1495 End Function ' SFDocuments.SF_Calc.DSum
1497 REM -----------------------------------------------------------------------------
1498 Public Function ExportRangeToFile(Optional ByVal Range As Variant _
1499 , Optional ByVal FileName As Variant _
1500 , Optional ByVal ImageType As Variant _
1501 , Optional ByVal Overwrite As Variant _
1502 ) As Boolean
1503 ''' Store the given range as an image to the given file location
1504 ''' Actual selections are not impacted
1505 ''' Inspired by https://stackoverflow.com/questions/30509532/how-to-export-cell-range-to-pdf-file
1506 ''' Args:
1507 ''' Range: sheet name or cell range to be exported, as a string
1508 ''' FileName: Identifies the file where to save. It must follow the SF_FileSystem.FileNaming notation
1509 ''' ImageType: the name of the targeted media type
1510 ''' Allowed values: jpeg, pdf (default) and png
1511 ''' Overwrite: True if the destination file may be overwritten (default = False)
1512 ''' Returns:
1513 ''' False if the document could not be saved
1514 ''' Exceptions:
1515 ''' RANGEEXPORTERROR The destination has its readonly attribute set or overwriting rejected
1516 ''' Examples:
1517 ''' oDoc.ExportRangeToFile('SheetX.B2:J15", "C:\Me\Range2.png", ImageType := "png", Overwrite := True)
1519 Dim bSaved As Boolean ' return value
1520 Dim oSfa As Object ' com.sun.star.ucb.SimpleFileAccess
1521 Dim sFile As String ' Alias of FileName
1522 Dim vStoreArguments As Variant ' Array of com.sun.star.beans.PropertyValue
1523 Dim vFilterData As Variant ' Array of com.sun.star.beans.PropertyValue
1524 Dim FSO As Object ' SF_FileSystem
1525 Dim vImageTypes As Variant ' Array of permitted image types
1526 Dim vFilters As Variant ' Array of corresponding filters in the same order as vImageTypes
1527 Dim sFilter As String ' The filter to apply
1528 Dim oSelect As Object ' Currently selected range(s)
1529 Dim oAddress As Object ' Alias of Range
1535 Const cstSubArgs = "Range, FileName, [ImageType=""pdf""|""jpeg""|""png""], [Overwrite=False]"
1537 If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo CatchError
1538 bSaved = False
1540 Check:
1542 If IsMissing(Overwrite) Or IsEmpty(Overwrite) Then Overwrite = False
1545 If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
1546 If Not _IsStillAlive() Then GoTo Finally
1549 If Not ScriptForge.SF_Utils._Validate(ImageType, "ImageType", V_STRING, vImageTypes) Then GoTo Finally
1550 If Not ScriptForge.SF_Utils._Validate(Overwrite, "Overwrite", ScriptForge.V_BOOLEAN) Then GoTo Finally
1551 End If
1553 ' Check destination file overwriting
1555 sFile = FSO._ConvertToUrl(FileName)
1556 If FSO.FileExists(FileName) Then
1557 If Overwrite = False Then GoTo CatchError
1559 If oSfa.isReadonly(sFile) Then GoTo CatchError
1560 End If
1562 Try:
1563 ' Setup arguments
1565 sFilter = vFilters(ScriptForge.SF_Array.IndexOf(vImageTypes, ImageType, CaseSensitive := False))
1566 Set oAddress = _ParseAddress(Range)
1568 ' The filter arguments differ between
1572 vFilterData = Array(ScriptForge.SF_Utils._MakePropertyValue("Selection", oAddress.XCellRange) )
1573 vStoreArguments = Array( _
1576 )
1577 Else ' png, jpeg
1578 ' Save the current selection(s)
1579 Set oSelect = _Component.CurrentController.getSelection()
1580 _Component.CurrentController.select(oAddress.XCellRange)
1581 vStoreArguments = Array( _
1584 )
1585 End If
1587 ' Apply the filter and export
1588 _Component.storeToUrl(sFile, vStoreArguments)
1591 bSaved = True
1593 Finally:
1594 ExportRangeToFile = bSaved
1595 ScriptForge.SF_Utils._ExitFunction(cstThisSub)
1596 Exit Function
1597 Catch:
1598 GoTo Finally
1599 CatchError:
1600 ScriptForge.SF_Exception.RaiseFatal(RANGEEXPORTERROR, "FileName", FileName, "Overwrite", Overwrite)
1601 GoTo Finally
1602 End Function ' SFDocuments.SF_Chart.ExportRangeToFile
1604 REM -----------------------------------------------------------------------------
1605 Public Function Forms(Optional ByVal SheetName As Variant _
1606 , Optional ByVal Form As Variant _
1607 ) As Variant
1608 ''' Return either
1609 ''' - the list of the Forms contained in the given sheet
1610 ''' - a SFDocuments.Form object based on its name or its index
1611 ''' Args:
1612 ''' SheetName: the name of the sheet containing the requested form or forms
1613 ''' Form: a form stored in the document given by its name or its index
1614 ''' When absent, the list of available forms is returned
1616 ''' Exceptions:
1617 ''' CALCFORMNOTFOUNDERROR Form not found
1618 ''' Returns:
1619 ''' A zero-based array of strings if Form is absent
1620 ''' An instance of the SF_Form class if Form exists
1621 ''' Example:
1622 ''' Dim myForm As Object, myList As Variant
1626 Dim oForm As Object ' The new Form class instance
1627 Dim oMainForm As Object ' com.sun.star.comp.sdb.Content
1628 Dim oXForm As Object ' com.sun.star.form.XForm or com.sun.star.comp.forms.ODatabaseForm
1629 Dim vFormNames As Variant ' Array of form names
1630 Dim oForms As Object ' Forms collection
1636 If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
1638 Check:
1639 If IsMissing(Form) Or IsEmpty(Form) Then Form = ""
1640 If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
1641 If Not _IsStillAlive() Then GoTo Finally
1643 If Not ScriptForge.SF_Utils._Validate(Form, "Form", Array(V_STRING, ScriptForge.V_NUMERIC)) Then GoTo Finally
1644 End If
1646 Try:
1647 ' Start from the Calc sheet and go down to forms
1648 Set oForms = _Component.getSheets.getByName(SheetName).DrawPage.Forms
1649 vFormNames = oForms.getElementNames()
1652 Forms = vFormNames
1653 Else
1654 If VarType(Form) = V_STRING Then ' Find the form by name
1655 If Not ScriptForge.SF_Utils._Validate(Form, "Form", V_STRING, vFormNames) Then GoTo Finally
1656 Set oXForm = oForms.getByName(Form)
1657 Else ' Find the form by index
1659 Set oXForm = oForms.getByIndex(Form)
1660 End If
1661 ' Create the new Form class instance
1662 Set oForm = SF_Register._NewForm(oXForm)
1663 With oForm
1664 Set .[_Parent] = [Me]
1665 ._SheetName = SheetName
1666 ._FormType = ISCALCFORM
1667 Set ._Component = _Component
1668 ._Initialize()
1669 End With
1670 Set Forms = oForm
1671 End If
1673 Finally:
1674 ScriptForge.SF_Utils._ExitFunction(cstThisSub)
1675 Exit Function
1676 Catch:
1677 GoTo Finally
1678 CatchNotFound:
1679 ScriptForge.SF_Exception.RaiseFatal(CALCFORMNOTFOUNDERROR, Form, _FileIdent())
1680 End Function ' SFDocuments.SF_Calc.Forms
1682 REM -----------------------------------------------------------------------------
1683 Function GetColumnName(Optional ByVal ColumnNumber As Variant) As String
1684 ''' Convert a column number (range 1, 2,..1024) into its letter counterpart (range 'A', 'B',..'AMJ').
1685 ''' Args:
1687 ''' Returns:
1688 ''' a string representation of the column name, in range 'A'..'AMJ'
1689 ''' If ColumnNumber is not in the allowed range, returns a zero-length string
1690 ''' Example:
1692 ''' Adapted from a Python function by sundar nataraj
1693 ''' http://stackoverflow.com/questions/23861680/convert-spreadsheet-number-to-column-letter
1695 Dim sCol As String ' Return value
1699 If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
1700 sCol = ""
1702 Check:
1703 If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
1705 End If
1707 Try:
1708 If (ColumnNumber > 0) And (ColumnNumber <= MAXCOLS) Then sCol = _GetColumnName(ColumnNumber)
1710 Finally:
1711 GetColumnName = sCol
1712 ScriptForge.SF_Utils._ExitFunction(cstThisSub)
1713 Exit Function
1714 Catch:
1715 GoTo Finally
1716 End Function ' SFDocuments.SF_Calc.GetColumnName
1718 REM -----------------------------------------------------------------------------
1719 Public Function GetFormula(Optional ByVal Range As Variant) As Variant
1720 ''' Get the formula(e) stored in the given range of cells
1721 ''' Args:
1722 ''' Range : the range as a string where to get the formula from
1723 ''' Returns:
1725 ''' Examples:
1728 Dim vGet As Variant ' Return value
1729 Dim oAddress As Object ' Alias of Range
1730 Dim vDataArray As Variant ' DataArray compatible with .DataArray UNO property
1734 If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
1735 vGet = Empty
1737 Check:
1738 If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
1739 If Not _IsStillAlive() Then GoTo Finally
1741 End If
1743 Try:
1744 ' Get the data
1745 Set oAddress = _ParseAddress(Range)
1746 vDataArray = oAddress.XCellRange.getFormulaArray()
1748 ' Convert the data array to scalar, vector or array
1749 vGet = _ConvertFromDataArray(vDataArray)
1751 Finally:
1752 GetFormula = vGet
1753 ScriptForge.SF_Utils._ExitFunction(cstThisSub)
1754 Exit Function
1755 Catch:
1756 GoTo Finally
1757 End Function ' SFDocuments.SF_Calc.GetFormula
1759 REM -----------------------------------------------------------------------------
1760 Public Function GetProperty(Optional ByVal PropertyName As Variant _
1761 , Optional ObjectName As Variant _
1762 ) As Variant
1763 ''' Return the actual value of the given property
1764 ''' Args:
1765 ''' PropertyName: the name of the property as a string
1766 ''' ObjectName: a sheet or range name
1767 ''' Returns:
1768 ''' The actual value of the property
1769 ''' Exceptions:
1770 ''' ARGUMENTERROR The property does not exist
1773 Const cstSubArgs = ""
1775 If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
1776 GetProperty = Null
1778 Check:
1779 If IsMissing(ObjectName) Or IsEMpty(ObjectName) Then ObjectName = ""
1780 If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
1781 If Not ScriptForge.SF_Utils._Validate(PropertyName, "PropertyName", V_STRING, Properties()) Then GoTo Catch
1782 If Not ScriptForge.SF_Utils._Validate(ObjectName, "ObjectName", V_STRING) Then GoTo Catch
1783 End If
1785 Try:
1786 ' Superclass or subclass property ?
1787 If ScriptForge.SF_Array.Contains([_Super].Properties(), PropertyName) Then
1788 GetProperty = [_Super].GetProperty(PropertyName)
1789 ElseIf Len(ObjectName) = 0 Then
1790 GetProperty = _PropertyGet(PropertyName)
1791 Else
1792 GetProperty = _PropertyGet(PropertyName, ObjectName)
1793 End If
1795 Finally:
1796 ScriptForge.SF_Utils._ExitFunction(cstThisSub)
1797 Exit Function
1798 Catch:
1799 GoTo Finally
1800 End Function ' SFDocuments.SF_Calc.GetProperty
1802 REM -----------------------------------------------------------------------------
1803 Public Function GetValue(Optional ByVal Range As Variant) As Variant
1804 ''' Get the value(s) stored in the given range of cells
1805 ''' Args:
1806 ''' Range : the range as a string where to get the value from
1807 ''' Returns:
1808 ''' A scalar, a zero-based 1D array or a zero-based 2D array of strings and doubles
1809 ''' To convert doubles to dates, use the CDate builtin function
1810 ''' Examples:
1813 Dim vGet As Variant ' Return value
1814 Dim oAddress As Object ' Alias of Range
1815 Dim vDataArray As Variant ' DataArray compatible with .DataArray UNO property
1819 If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
1820 vGet = Empty
1822 Check:
1823 If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
1824 If Not _IsStillAlive() Then GoTo Finally
1826 End If
1828 Try:
1829 ' Get the data
1830 Set oAddress = _ParseAddress(Range)
1831 vDataArray = oAddress.XCellRange.getDataArray()
1833 ' Convert the data array to scalar, vector or array
1834 vGet = _ConvertFromDataArray(vDataArray)
1836 Finally:
1837 GetValue = vGet
1838 ScriptForge.SF_Utils._ExitFunction(cstThisSub)
1839 Exit Function
1840 Catch:
1841 GoTo Finally
1842 End Function ' SFDocuments.SF_Calc.GetValue
1844 REM -----------------------------------------------------------------------------
1845 Public Function ImportFromCSVFile(Optional ByVal FileName As Variant _
1846 , Optional ByVal DestinationCell As Variant _
1847 , Optional ByVal FilterOptions As Variant _
1848 ) As String
1849 ''' Import the content of a CSV-formatted text file starting from a given cell
1850 ''' Beforehand the destination area will be cleared from any content and format
1851 ''' Args:
1852 ''' FileName: Identifies the file to open. It must follow the SF_FileSystem.FileNaming notation
1853 ''' DestinationCell: the destination of the copied range of cells, as a string
1854 ''' If given as range, the destination will be reduced to its top-left cell
1855 ''' FilterOptions: The arguments of the CSV input filter.
1856 ''' Read https://wiki.documentfoundation.org/Documentation/DevGuide/Spreadsheet_Documents#Filter_Options_for_the_CSV_Filter
1857 ''' Default: input file encoding is UTF8
1858 ''' separator = comma, semi-colon or tabulation
1859 ''' string delimiter = double quote
1860 ''' all lines are included
1861 ''' quoted strings are formatted as texts
1862 ''' special numbers are detected
1863 ''' all columns are presumed texts
1864 ''' language = english/US => decimal separator is ".", thousands separator = ","
1865 ''' Returns:
1866 ''' A string representing the modified range of cells
1867 ''' The modified area depends only on the content of the source file
1868 ''' Exceptions:
1869 ''' DOCUMENTOPENERROR The csv file could not be opened
1870 ''' Examples:
1871 ''' oDoc.ImportFromCSVFile("C:\Temp\myCsvFile.csv", "SheetY.C5")
1873 Dim sImport As String ' Return value
1874 Dim oUI As Object ' UI service
1875 Dim oSource As Object ' New Calc document with csv loaded
1876 Dim oSelect As Object ' Current selection in destination
1881 Const cstSubArgs = "FileName, DestinationCell, [FilterOptions]=""9/44/59/MRG,34,76,1,,1033,true,true"""
1883 ' If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
1884 sImport = ""
1886 Check:
1887 If IsMissing(FilterOptions) Or IsEmpty(FilterOptions) Then FilterOptions = cstFilterOptions
1888 If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
1889 If Not _IsStillAlive(True) Then GoTo Finally
1891 If Not ScriptForge.SF_Utils._Validate(DestinationCell, "DestinationCell", V_STRING) Then GoTo Finally
1892 End If
1894 Try:
1895 ' Input file is loaded in an empty worksheet. Data are copied to destination cell
1897 Set oSource = oUI.OpenDocument(FileName _
1898 , ReadOnly := True _
1899 , Hidden := True _
1900 , FilterName := cstFilter _
1901 , FilterOptions := FilterOptions _
1902 )
1903 ' Remember current selection and restore it after copy
1904 Set oSelect = _Component.CurrentController.getSelection()
1906 _RestoreSelections(_Component, oSelect)
1908 Finally:
1909 If Not IsNull(oSource) Then oSource.CloseDocument(False)
1910 ImportFromCSVFile = sImport
1911 ScriptForge.SF_Utils._ExitFunction(cstThisSub)
1912 Exit Function
1913 Catch:
1914 GoTo Finally
1915 End Function ' SFDocuments.SF_Calc.ImportFromCSVFile
1917 REM -----------------------------------------------------------------------------
1918 Public Sub ImportFromDatabase(Optional ByVal FileName As Variant _
1919 , Optional ByVal RegistrationName As Variant _
1920 , Optional ByVal DestinationCell As Variant _
1921 , Optional ByVal SQLCommand As Variant _
1922 , Optional ByVal DirectSQL As Variant _
1923 )
1924 ''' Import the content of a database table, query or resultset, i.e. the result of a SELECT SQL command,
1925 ''' starting from a given cell
1926 ''' Beforehand the destination area will be cleared from any content and format
1927 ''' The modified area depends only on the content of the source data
1928 ''' Args:
1929 ''' FileName: Identifies the file to open. It must follow the SF_FileSystem.FileNaming notation
1930 ''' RegistrationName: the name of a registered database
1932 ''' DestinationCell: the destination of the copied range of cells, as a string
1933 ''' If given as a range of cells, the destination will be reduced to its top-left cell
1934 ''' SQLCommand: either a table or query name (without square brackets)
1935 ''' or a full SQL commands where table and fieldnames are preferably surrounded with square brackets
1936 ''' Returns:
1937 ''' Implemented as a Sub because the doImport UNO method does not return any error
1938 ''' Exceptions:
1939 ''' BASEDOCUMENTOPENERROR The database file could not be opened
1940 ''' Examples:
1941 ''' oDoc.ImportFromDatabase("C:\Temp\myDbFile.odb", , "SheetY.C5", "SELECT * FROM [Employees] ORDER BY [LastName]")
1943 Dim oDBContext As Object ' com.sun.star.sdb.DatabaseContext
1944 Dim oDatabase As Object ' SFDatabases.Database service
1945 Dim lCommandType As Long ' A com.sun.star.sheet.DataImportMode.xxx constant
1946 Dim oQuery As Object ' com.sun.star.ucb.XContent
1947 Dim bDirect As Boolean ' Alias of DirectSQL
1948 Dim oDestRange As Object ' Destination as a range
1949 Dim oDestAddress As Object ' com.sun.star.table.CellRangeAddress
1950 Dim oDestCell As Object ' com.sun.star.table.XCell
1951 Dim oSelect As Object ' Current selection in destination
1952 Dim vImportOptions As Variant ' Array of PropertyValues
1955 Const cstSubArgs = "[FileName=""""], [RegistrationName=""""], DestinationCell, SQLCommand, [DirectSQL=False]"
1957 ' If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
1959 Check:
1961 If IsMissing(FileName) Or IsEmpty(FileName) Then FileName = ""
1962 If IsMissing(RegistrationName) Or IsEmpty(RegistrationName) Then RegistrationName = ""
1963 If IsMissing(DirectSQL) Or IsEmpty(DirectSQL) Then DirectSQL = False
1964 If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
1965 If Not _IsStillAlive(True) Then GoTo Finally
1966 If Not ScriptForge.SF_Utils._ValidateFile(FileName, "FileName", , True) Then GoTo Finally
1967 If Not ScriptForge.SF_Utils._Validate(DestinationCell, "DestinationCell", V_STRING) Then GoTo Finally
1968 If Not ScriptForge.SF_Utils._Validate(SQLCommand, "SQLCommand", V_STRING) Then GoTo Finally
1969 If Not ScriptForge.SF_Utils._Validate(DirectSQL, "DirectSQL", ScriptForge.V_BOOLEAN) Then GoTo Finally
1970 End If
1972 ' Check the existence of FileName
1974 If Len(RegistrationName) = 0 Then GoTo CatchError
1976 If Not oDBContext.hasRegisteredDatabase(RegistrationName) Then GoTo CatchError
1977 FileName = ScriptForge.SF_FileSystem._ConvertFromUrl(oDBContext.getDatabaseLocation(RegistrationName))
1978 End If
1979 If Not ScriptForge.SF_FileSystem.FileExists(FileName) Then GoTo CatchError
1981 Try:
1982 ' Check command type
1983 Set oDatabase = ScriptForge.SF_Services.CreateScriptService("SFDatabases.Database", FileName, , True) ' Read-only
1984 If IsNull(oDatabase) Then GoTo CatchError
1985 With oDatabase
1986 If ScriptForge.SF_Array.Contains(.Tables, SQLCommand) Then
1987 bDirect = True
1988 lCommandType = com.sun.star.sheet.DataImportMode.TABLE
1989 ElseIf ScriptForge.SF_Array.Contains(.Queries, SQLCommand) Then
1990 Set oQuery = .XConnection.Queries.getByName(SQLCommand)
1991 bDirect = Not oQuery.EscapeProcessing
1992 lCommandType = com.sun.star.sheet.DataImportMode.QUERY
1993 Else
1994 bDirect = DirectSQL
1995 lCommandType = com.sun.star.sheet.DataImportMode.SQL
1996 SQLCommand = ._ReplaceSquareBrackets(SQLCommand)
1997 End If
1998 .CloseDatabase()
1999 Set oDatabase = oDatabase.Dispose()
2000 End With
2002 ' Determine the destination cell as the top-left coordinates of the given range
2003 Set oDestRange = _ParseAddress(DestinationCell)
2004 Set oDestAddress = oDestRange.XCellRange.RangeAddress
2005 Set oDestCell = oDestRange.XSpreadsheet.getCellByPosition(oDestAddress.StartColumn, oDestAddress.StartRow)
2007 ' Remember current selection
2008 Set oSelect = _Component.CurrentController.getSelection()
2009 ' Import arguments
2010 vImportOptions = Array(_
2011 ScriptForge.SF_Utils._MakePropertyValue("DatabaseName", ScriptForge.SF_FileSystem._ConvertToUrl(FileName)) _
2015 )
2016 oDestCell.doImport(vImportOptions)
2017 ' Restore selection after import_
2018 _RestoreSelections(_Component, oSelect)
2020 Finally:
2021 ScriptForge.SF_Utils._ExitFunction(cstThisSub)
2022 Exit Sub
2023 Catch:
2024 GoTo Finally
2025 CatchError:
2026 SF_Exception.RaiseFatal(BASEDOCUMENTOPENERROR, "FileName", FileName, "RegistrationName", RegistrationName)
2027 GoTo Finally
2028 End Sub ' SFDocuments.SF_Calc.ImportFromDatabase
2030 REM -----------------------------------------------------------------------------
2031 Public Function InsertSheet(Optional ByVal SheetName As Variant _
2032 , Optional ByVal BeforeSheet As Variant _
2033 ) As Boolean
2034 ''' Insert a new empty sheet before an existing sheet or at the end of the list of sheets
2035 ''' Args:
2036 ''' SheetName: The name of the new sheet
2037 ''' BeforeSheet: The name (string) or index (numeric, starting from 1) of the sheet before which to insert
2038 ''' Returns:
2039 ''' True if the sheet could be inserted successfully
2040 ''' Examples:
2043 Dim bInsert As Boolean ' Return value
2044 Dim vSheets As Variant ' List of existing sheets
2045 Dim lSheetIndex As Long ' Index of a sheet
2049 If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
2050 bInsert = False
2052 Check:
2053 If IsMissing(BeforeSheet) Or IsEmpty(BeforeSheet) Then BeforeSheet = 32768
2054 If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
2055 If Not _IsStillAlive(True) Then GoTo Finally
2058 End If
2059 vSheets = _Component.getSheets.getElementNames()
2061 Try:
2062 If VarType(BeforeSheet) = V_STRING Then
2063 lSheetIndex = ScriptForge.SF_Array.IndexOf(vSheets, BeforeSheet)
2064 Else
2065 lSheetIndex = BeforeSheet - 1
2068 End If
2069 _Component.getSheets.insertNewByName(SheetName, lSheetIndex)
2070 bInsert = True
2072 Finally:
2073 InsertSheet = binsert
2074 ScriptForge.SF_Utils._ExitFunction(cstThisSub)
2075 Exit Function
2076 Catch:
2077 GoTo Finally
2078 End Function ' SFDocuments.SF_Calc.InsertSheet
2080 REM -----------------------------------------------------------------------------
2081 Public Function Methods() As Variant
2082 ''' Return the list of public methods of the Calc service as an array
2084 Methods = Array( _
2124 )
2126 End Function ' SFDocuments.SF_Calc.Methods
2128 REM -----------------------------------------------------------------------------
2129 Public Function MoveRange(Optional ByVal Source As Variant _
2130 , Optional ByVal Destination As Variant _
2131 ) As String
2132 ''' Move a specified source range to a destination range
2133 ''' Args:
2134 ''' Source: the source range of cells as a string
2135 ''' Destination: the destination of the moved range of cells, as a string
2136 ''' If given as a range of cells, the destination will be reduced to its top-left cell
2137 ''' Returns:
2138 ''' A string representing the modified range of cells
2139 ''' The modified area depends only on the size of the source area
2140 ''' Examples:
2143 Dim sMove As String ' Return value
2144 Dim oSource As Object ' Alias of Source to avoid "Object variable not set" run-time error
2145 Dim oSourceAddress As Object ' com.sun.star.table.CellRangeAddress
2146 Dim oDestRange As Object ' Destination as a range
2147 Dim oDestAddress As Object ' com.sun.star.table.CellRangeAddress
2148 Dim oDestCell As Object ' com.sun.star.table.CellAddress
2149 Dim oSelect As Object ' Current selection in source
2150 Dim oClipboard As Object ' com.sun.star.datatransfer.XTransferable
2151 Dim oCellRanges As Object ' com.sun.star.sheet.SheetCellRanges
2152 Dim vRangeAddresses As Variant ' Array of com.sun.star.table.CellRangeAddress
2153 Dim i As Long
2158 If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
2159 sMove = ""
2161 Check:
2162 If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
2163 If Not _IsStillAlive(True) Then GoTo Finally
2166 End If
2168 Try:
2169 Set oSourceAddress = _ParseAddress(Source).XCellRange.RangeAddress
2170 Set oDestRange = _ParseAddress(Destination)
2171 Set oDestAddress = oDestRange.XCellRange.RangeAddress
2172 Set oDestCell = New com.sun.star.table.CellAddress
2173 With oDestAddress
2174 oDestCell.Sheet = .Sheet
2175 oDestCell.Column = .StartColumn
2176 oDestCell.Row = .StartRow
2177 End With
2178 oDestRange.XSpreadsheet.moveRange(oDestCell, oSourceAddress)
2180 With oSourceAddress
2181 sMove = _Offset(Destination, 0, 0, .EndRow - .StartRow + 1, .EndColumn - .StartColumn + 1).RangeName
2182 End With
2184 Finally:
2185 MoveRange = sMove
2186 ScriptForge.SF_Utils._ExitFunction(cstThisSub)
2187 Exit Function
2188 Catch:
2189 GoTo Finally
2190 End Function ' SFDocuments.SF_Calc.MoveRange
2192 REM -----------------------------------------------------------------------------
2193 Public Function MoveSheet(Optional ByVal SheetName As Variant _
2194 , Optional ByVal BeforeSheet As Variant _
2195 ) As Boolean
2196 ''' Move a sheet before an existing sheet or at the end of the list of sheets
2197 ''' Args:
2198 ''' SheetName: The name of the sheet to move
2199 ''' BeforeSheet: The name (string) or index (numeric, starting from 1) of the sheet before which to move the sheet
2200 ''' Returns:
2201 ''' True if the sheet could be moved successfully
2202 ''' Examples:
2205 Dim bMove As Boolean ' Return value
2206 Dim vSheets As Variant ' List of existing sheets
2207 Dim lSheetIndex As Long ' Index of a sheet
2211 If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
2212 bMove = False
2214 Check:
2215 If IsMissing(BeforeSheet) Or IsEmpty(BeforeSheet) Then BeforeSheet = 32768
2216 If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
2217 If Not _IsStillAlive(True) Then GoTo Finally
2220 End If
2221 vSheets = _Component.getSheets.getElementNames()
2223 Try:
2224 If VarType(BeforeSheet) = V_STRING Then
2225 lSheetIndex = ScriptForge.SF_Array.IndexOf(vSheets, BeforeSheet)
2226 Else
2227 lSheetIndex = BeforeSheet - 1
2230 End If
2231 _Component.getSheets.MoveByName(SheetName, lSheetIndex)
2232 bMove = True
2234 Finally:
2235 MoveSheet = bMove
2236 ScriptForge.SF_Utils._ExitFunction(cstThisSub)
2237 Exit Function
2238 Catch:
2239 GoTo Finally
2240 End Function ' SFDocuments.SF_Calc.MoveSheet
2242 REM -----------------------------------------------------------------------------
2243 Public Function Offset(Optional ByRef Range As Variant _
2244 , Optional ByVal Rows As Variant _
2245 , Optional ByVal Columns As Variant _
2246 , Optional ByVal Height As Variant _
2247 , Optional ByVal Width As Variant _
2248 ) As String
2249 ''' Returns a new range offset by a certain number of rows and columns from a given range
2250 ''' Args:
2251 ''' Range : the range, as a string, from which the function searches for the new range
2252 ''' Rows : the number of rows by which the reference was corrected up (negative value) or down.
2254 ''' Columns : the number of columns by which the reference was corrected to the left (negative value) or to the right.
2256 ''' Height : the vertical height for an area that starts at the new reference position.
2257 ''' Default = no vertical resizing
2258 ''' Width : the horizontal width for an area that starts at the new reference position.
2259 ''' Default - no horizontal resizing
2260 ''' Arguments Rows and Columns must not lead to zero or negative start row or column.
2261 ''' Arguments Height and Width must not lead to zero or negative count of rows or columns.
2262 ''' Returns:
2263 ''' A new range as a string
2264 ''' Exceptions:
2265 ''' OFFSETADDRESSERROR The computed range of cells falls beyond the sheet boundaries
2266 ''' Examples:
2267 ''' oDoc.Offset("A1", 2, 2) ' "'SheetX'.$C$3" (A1 moved by two rows and two columns down)
2268 ''' oDoc.Offset("A1", 2, 2, 5, 6) ' "'SheetX'.$C$3:$H$7"
2270 Dim sOffset As String ' Return value
2271 Dim oAddress As Object ' Alias of Range
2275 If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
2276 sOffset = ""
2278 Check:
2279 If IsMissing(Rows) Or IsEmpty(Rows) Then Rows = 0
2280 If IsMissing(Columns) Or IsEmpty(Columns) Then Columns = 0
2281 If IsMissing(Height) Or IsEmpty(Height) Then Height = 0
2282 If IsMissing(Width) Or IsEmpty(Width) Then Width = 0
2283 If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
2284 If Not _IsStillAlive() Then GoTo Finally
2286 If Not ScriptForge.SF_Utils._Validate(Rows, "Rows", ScriptForge.V_NUMERIC) Then GoTo Finally
2287 If Not ScriptForge.SF_Utils._Validate(Columns, "Columns", ScriptForge.V_NUMERIC) Then GoTo Finally
2288 If Not ScriptForge.SF_Utils._Validate(Height, "Height", ScriptForge.V_NUMERIC) Then GoTo Finally
2289 If Not ScriptForge.SF_Utils._Validate(Width, "Width", ScriptForge.V_NUMERIC) Then GoTo Finally
2290 End If
2292 Try:
2293 ' Define the new range string
2294 Set oAddress = _Offset(Range, Rows, Columns, Height, Width)
2295 sOffset = oAddress.RangeName
2297 Finally:
2298 Offset = sOffset
2299 ScriptForge.SF_Utils._ExitFunction(cstThisSub)
2300 Exit Function
2301 Catch:
2302 GoTo Finally
2303 End Function ' SFDocuments.SF_Calc.Offset
2305 REM -----------------------------------------------------------------------------
2306 Public Function OpenRangeSelector(Optional ByVal Title As Variant _
2307 , Optional ByVal Selection As Variant _
2308 , Optional ByVal SingleCell As Variant _
2309 , Optional ByVal CloseAfterSelect As Variant _
2310 ) As String
2311 ''' Activates the Calc document, opens a non-modal dialog with a text box,
2312 ''' let the user make a selection in the current or another sheet and
2313 ''' returns the selected area as a string.
2314 ''' This method does not change the current selection.
2315 ''' Args:
2316 ''' Title: the title to display on the top of the dialog
2317 ''' Selection: a default preselection as a String. When absent, the first element of the
2318 ''' current selection is preselected.
2319 ''' SingleCell: When True, only a single cell may be selected. Default = False
2320 ''' CloseAfterSelect: When True (default-, the dialog is closed immediately after
2321 ''' the selection. When False, the user may change his/her mind and must close
2322 ''' the dialog manually.
2323 ''' Returns:
2324 ''' The selected range as a string, or the empty string when the user cancelled the request (close window button)
2325 ''' Exceptions:
2326 ''' Examples:
2327 ''' Dim sSelect As String, vValues As Variant
2330 ''' vValues = oDoc.GetValue(sSelect)
2332 Dim sSelector As String ' Return value
2333 Dim vPropertyValues As Variant ' Array of com.sun.star.beans.PropertyValue
2334 Dim oSelection As Object ' The current selection before opening the selector
2335 Dim oAddress As Object ' Preselected address as _Address
2338 Const cstSubArgs = "[Title=""""], [Selection=""~""], [SingleCell=False], [CloseAfterSelect=True]"
2340 If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
2341 sSelector = ""
2343 Check:
2344 If IsMissing(Title) Or IsEmpty(Title) Then Title = ""
2346 If IsMissing(SingleCell) Or IsEmpty(SingleCell) Then SingleCell = False
2347 If IsMissing(CloseAfterSelect) Or IsEmpty(CloseAfterSelect) Then CloseAfterSelect = True
2348 If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
2349 If Not _IsStillAlive() Then GoTo Finally
2351 If Not ScriptForge.SF_Utils._Validate(Selection, "Selection", V_STRING) Then GoTo Finally
2352 If Not ScriptForge.SF_Utils._Validate(SingleCell, "SingleCell", ScriptForge.V_BOOLEAN) Then GoTo Finally
2353 If Not ScriptForge.SF_Utils._Validate(CloseAfterSelect, "CloseAfterSelect", ScriptForge.V_BOOLEAN) Then GoTo Finally
2354 End If
2356 Try:
2357 ' Save the current selections
2358 Set oSelection = _Component.CurrentController.getSelection()
2360 ' Process preselection and select its containing sheet
2361 Set oAddress = _ParseAddress(Selection)
2362 Activate(oAddress.SheetName)
2364 ' Build arguments array and execute the dialog box
2365 With ScriptForge.SF_Utils
2366 vPropertyValues = Array( _
2371 )
2372 End With
2373 sSelector = SF_DocumentListener.RunRangeSelector(_Component, vPropertyValues)
2375 ' Restore the saved selections
2376 _RestoreSelections(_Component, oSelection)
2378 Finally:
2379 OpenRangeSelector = sSelector
2380 ScriptForge.SF_Utils._ExitFunction(cstThisSub)
2381 Exit Function
2382 Catch:
2383 GoTo Finally
2384 End Function ' SFDocuments.SF_Calc.OpenRangeSelector
2386 REM -----------------------------------------------------------------------------
2387 Public Function Printf(Optional ByVal InputStr As Variant _
2388 , Optional ByVal Range As Variant _
2389 , Optional ByVal TokenCharacter As Variant _
2390 ) As String
2391 ''' Returns the input string after substitution of its tokens by
2392 ''' their values in the given range
2393 ''' This method is usually used in combination with SetFormula()
2394 ''' The accepted tokens are:
2395 ''' - %S The sheet name containing the range, including single quotes when necessary
2396 ''' - %R1 The row number of the topleft part of the range
2397 ''' - %C1 The column letter of the topleft part of the range
2398 ''' - %R2 The row number of the bottomright part of the range
2399 ''' - %C2 The column letter of the bottomright part of the range
2400 ''' Args:
2401 ''' InputStr: usually a Calc formula or a part of a formula, but may be any string
2402 ''' Range: the range, as a string from which the values of the tokens are derived
2404 ''' Double the TokenCharacter to not consider it as a token.
2405 ''' Returns:
2406 ''' The input string after substitution of the contained tokens
2407 ''' Exceptions:
2408 ''' Examples:
2409 ''' Assume we have in A1:E10 a matrix of numbers. To obtain the sum by row in F1:F10 ...
2410 ''' Dim range As String, formula As String
2412 ''' formula = "=SUM($%C1%R1:$%C2%R1)" ' "=SUM($A1:$E1)", note the relative references
2414 ''' 'F1 will contain =Sum($A1:$E1)
2415 ''' 'F2 =Sum($A2:$E2)
2416 ''' ' ...
2418 Dim sPrintf As String ' Return value
2419 Dim vSubstitute As Variants ' Array of strings representing the token values
2420 Dim oAddress As Object ' A range as an _Address object
2421 Dim sSheetName As String ' The %S token value
2422 Dim sC1 As String ' The %C1 token value
2423 Dim sR1 As String ' The %R1 token value
2424 Dim sC2 As String ' The %C2 token value
2425 Dim sR2 As String ' The %R2 token value
2426 Dim i As Long
2432 If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
2433 sPrintf = ""
2435 Check:
2437 If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
2438 If Not _IsStillAlive() Then GoTo Finally
2439 If Not ScriptForge.SF_Utils._Validate(InputStr, "InputStr", V_STRING) Then GoTo Finally
2441 If Not ScriptForge.SF_Utils._Validate(TokenCharacter, "TokenCharacter", V_STRING) Then GoTo Finally
2442 End If
2444 Try:
2445 ' Define the token values
2446 Set oAddress = _ParseAddress(Range)
2447 With oAddress.XCellRange
2448 sC1 = _GetColumnName(.RangeAddress.StartColumn + 1)
2449 sR1 = CStr(.RangeAddress.StartRow + 1)
2450 sC2 = _GetColumnName(.RangeAddress.EndColumn + 1)
2451 sR2 = CStr(.RangeAddress.EndRow + 1)
2452 sSheetName = _QuoteSheetName(oAddress.XSpreadsheet.Name)
2453 End With
2455 ' Substitute tokens by their values
2456 sPrintf = ScriptForge.SF_String.ReplaceStr(InputStr _
2457 , Array(TokenCharacter & TokenCharacter _
2463 , cstPseudoToken _
2464 ) _
2465 , Array(cstPseudoToken _
2466 , sR1 _
2467 , sC1 _
2468 , sR2 _
2469 , sC2 _
2470 , sSheetName _
2471 , TokenCharacter _
2472 ) _
2473 )
2475 Finally:
2476 Printf = sPrintf
2477 ScriptForge.SF_Utils._ExitFunction(cstThisSub)
2478 Exit Function
2479 Catch:
2480 GoTo Finally
2481 End Function ' SFDocuments.SF_Calc.Printf
2483 REM -----------------------------------------------------------------------------
2484 Public Function PrintOut(Optional ByVal SheetName As Variant _
2485 , Optional ByVal Pages As Variant _
2486 , Optional ByVal Copies As Variant _
2487 ) As Boolean
2488 ''' Send the content of the given sheet to the printer.
2489 ''' The printer might be defined previously by default, by the user or by the SetPrinter() method
2490 ''' Args:
2491 ''' SheetName: the sheet to print. Default = the active sheet
2492 ''' Pages: the pages to print as a string, like in the user interface. Example: "1-4;10;15-18". Default = all pages
2493 ''' Copies: the number of copies
2494 ''' Returns:
2495 ''' True when successful
2496 ''' Examples:
2499 Dim bPrint As Boolean ' Return value
2500 Dim oSheet As Object ' SheetName as a reference
2503 Const cstSubArgs = "[SheetName=""~""], [Pages=""""], [Copies=1]"
2505 If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
2506 bPrint = False
2508 Check:
2509 If IsMissing(SheetName) Or IsEmpty(SheetName) Then SheetName = ""
2510 If IsMissing(Pages) Or IsEmpty(Pages) Then Pages = ""
2511 If IsMissing(Copies) Or IsEmpty(Copies) Then Copies = 1
2513 If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
2514 If Not _IsStillAlive() Then GoTo Finally
2517 If Not ScriptForge.SF_Utils._Validate(Copies, "Copies", ScriptForge.V_NUMERIC) Then GoTo Finally
2518 End If
2520 Try:
2522 ' Make given sheet active
2524 With _Component
2525 Set oSheet = .getSheets.getByName(SheetName)
2526 Set .CurrentController.ActiveSheet = oSheet
2527 End With
2528 End If
2530 bPrint = [_Super].PrintOut(Pages, Copies, _Component)
2532 Finally:
2533 PrintOut = bPrint
2534 ScriptForge.SF_Utils._ExitFunction(cstThisSub)
2535 Exit Function
2536 Catch:
2537 GoTo Finally
2538 End Function ' SFDocuments.SF_Calc.PrintOut
2540 REM -----------------------------------------------------------------------------
2541 Public Function Properties() As Variant
2542 ''' Return the list or properties of the Calc class as an array
2544 Properties = Array( _
2579 )
2581 End Function ' SFDocuments.SF_Calc.Properties
2583 REM -----------------------------------------------------------------------------
2584 Public Function RemoveSheet(Optional ByVal SheetName As Variant) As Boolean
2585 ''' Remove an existing sheet from the document
2586 ''' Args:
2587 ''' SheetName: The name of the sheet to remove
2588 ''' Returns:
2589 ''' True if the sheet could be removed successfully
2590 ''' Examples:
2593 Dim bRemove As Boolean ' Return value
2597 If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
2598 bRemove = False
2600 Check:
2601 If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
2602 If Not _IsStillAlive(True) Then GoTo Finally
2604 End If
2606 Try:
2607 _Component.getSheets.RemoveByName(SheetName)
2608 bRemove = True
2610 Finally:
2611 RemoveSheet = bRemove
2612 ScriptForge.SF_Utils._ExitFunction(cstThisSub)
2613 Exit Function
2614 Catch:
2615 GoTo Finally
2616 End Function ' SFDocuments.SF_Calc.RemoveSheet
2618 REM -----------------------------------------------------------------------------
2619 Public Function RenameSheet(Optional ByVal SheetName As Variant _
2620 , Optional ByVal NewName As Variant _
2621 ) As Boolean
2622 ''' Rename a specified sheet
2623 ''' Args:
2624 ''' SheetName: The name of the sheet to rename
2625 ''' NewName: Must not exist
2626 ''' Returns:
2627 ''' True if the sheet could be renamed successfully
2628 ''' Exceptions:
2629 ''' DUPLICATESHEETERROR A sheet with the given name exists already
2630 ''' Examples:
2633 Dim bRename As Boolean ' Return value
2637 If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
2638 bRename = False
2640 Check:
2641 If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
2642 If Not _IsStillAlive(True) Then GoTo Finally
2645 End If
2647 Try:
2648 _Component.getSheets.getByName(SheetName).setName(NewName)
2649 bRename = True
2651 Finally:
2652 RenameSheet = bRename
2653 ScriptForge.SF_Utils._ExitFunction(cstThisSub)
2654 Exit Function
2655 Catch:
2656 GoTo Finally
2657 End Function ' SFDocuments.SF_Calc.RenameSheet
2659 REM -----------------------------------------------------------------------------
2660 Public Function SetArray(Optional ByVal TargetCell As Variant _
2661 , Optional ByRef Value As Variant _
2662 ) As String
2663 ''' Set the given (array of) values starting from the target cell
2664 ''' The updated area expands itself from the target cell or from the top-left corner of the given range
2665 ''' as far as determined by the size of the input Value.
2666 ''' Vectors are always expanded vertically
2667 ''' Args:
2668 ''' TargetCell : the cell or the range as a string that should receive a new value
2669 ''' Value: a scalar, a vector or an array with the new values
2670 ''' The new values should be strings, numeric values or dates. Other types empty the corresponding cell
2671 ''' Returns:
2672 ''' A string representing the updated range
2673 ''' Exceptions:
2674 ''' OFFSETADDRESSERROR The computed range of cells falls beyond the sheet boundaries
2675 ''' Examples:
2678 Dim sSet As String ' Return value
2679 Dim oSet As Object ' _Address alias of sSet
2680 Dim vDataArray As Variant ' DataArray compatible with .DataArray UNO property
2684 If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
2685 sSet = ""
2687 Check:
2688 If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
2689 If Not _IsStillAlive() Then GoTo Finally
2690 If Not ScriptForge.SF_Utils._Validate(TargetCell, "TargetCell", V_STRING) Then GoTo Finally
2691 If IsArray(Value) Then
2693 Else
2695 End If
2696 End If
2698 Try:
2699 ' Convert argument to data array and derive new range from its size
2700 vDataArray = _ConvertToDataArray(Value)
2701 If UBound(vDataArray) < LBound(vDataArray) Then GoTo Finally
2702 Set oSet = _Offset(TargetCell, 0, 0, plHeight := UBound(vDataArray) + 1, plWidth := UBound(vDataArray(0)) + 1) ' +1 : vDataArray is zero-based
2703 With oSet
2704 .XCellRange.setDataArray(vDataArray)
2705 sSet = .RangeName
2706 End With
2708 Finally:
2709 SetArray = sSet
2710 ScriptForge.SF_Utils._ExitFunction(cstThisSub)
2711 Exit Function
2712 Catch:
2713 GoTo Finally
2714 End Function ' SFDocuments.SF_Calc.SetArray
2716 REM -----------------------------------------------------------------------------
2717 Public Function SetCellStyle(Optional ByVal TargetRange As Variant _
2718 , Optional ByVal Style As Variant _
2719 , Optional ByVal FilterFormula As Variant _
2720 , Optional ByVal FilterScope As Variant _
2721 ) As String
2722 ''' Apply the given cell style in the given range
2723 ''' If the cell style does not exist, an error is raised
2724 ''' The range is updated and the remainder of the sheet is left untouched
2725 ''' Either the full range is updated or a selection based on a FilterFormula
2726 ''' Args:
2727 ''' TargetRange : the range as a string that should receive a new cell style
2728 ''' Style: the style name as a string
2729 ''' FilterFormula: a Calc formula to select among the given Range
2730 ''' When left empty, all the cells of the range are formatted with the new style
2731 ''' FilterScope: "CELL" (default value), "ROW" or "COLUMN"
2732 ''' When FilterFormula is present, FilterScope is mandatory
2733 ''' Returns:
2734 ''' A string representing the updated range
2735 ''' Examples:
2737 ''' oDoc.SetCellStype("A1:J20", "Wrong", "=(A1<0)", "CELL")
2739 Dim sSet As String ' Return value
2740 Dim oAddress As _Address ' Alias of TargetRange
2741 Dim oStyleFamilies As Object ' com.sun.star.container.XNameAccess
2742 Dim vStyles As Variant ' Array of existing cell styles
2743 Dim vRanges() As Variant ' Array of filtered ranges
2744 Dim i As Long
2748 Const cstSubArgs = "TargetRange, Style, [FilterFormula=""], [FilterScope=""CELL""|""ROW""|""COLUMN""]"
2750 If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
2751 sSet = ""
2753 Check:
2754 If IsMissing(FilterFormula) Or IsEmpty(FilterFormula) Then FilterFormula = ""
2756 If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
2757 If Not _IsStillAlive() Then GoTo Finally
2758 If Not ScriptForge.SF_Utils._Validate(TargetRange, "TargetRange", Array(V_STRING, ScriptForge.V_OBJECT)) Then GoTo Finally
2759 ' Check that the given style really exists
2760 Set oStyleFamilies = _Component.StyleFamilies
2761 If oStyleFamilies.hasByName(cstStyle) Then vStyles = oStyleFamilies.getByName(cstStyle).getElementNames() Else vStyles = Array()
2762 If Not ScriptForge.SF_Utils._Validate(Style, "Style", V_STRING, vStyles) Then GoTo Finally
2763 ' Filter formula
2764 If Not ScriptForge.SF_Utils._Validate(FilterFormula, "FilterFormula", V_STRING) Then GoTo Finally
2766 If Not ScriptForge.SF_Utils._Validate(FilterScope, "FilterScope", V_STRING, Array("CELL", "ROW", "COLUMN")) Then GoTo Finally
2767 Else
2768 If Not ScriptForge.SF_Utils._Validate(FilterScope, "FilterScope", V_STRING) Then GoTo Finally
2769 End If
2770 End If
2772 Try:
2773 If VarType(TargetRange) = V_STRING Then Set oAddress = _ParseAddress(TargetRange) Else Set oAddress = TargetRange
2774 With oAddress
2776 .XCellRange.CellStyle = Style
2777 Else ' When the range has to be cut in subranges
2778 vRanges() = _ComputeFilter(oAddress, FilterFormula, UCase(FilterScope))
2779 For i = 0 To UBound(vRanges)
2780 vRanges(i).XCellRange.CellStyle = Style
2781 Next i
2782 End If
2783 sSet = .RangeName
2784 End With
2786 Finally:
2787 SetCellStyle = sSet
2788 ScriptForge.SF_Utils._ExitFunction(cstThisSub)
2789 Exit Function
2790 Catch:
2791 GoTo Finally
2792 End Function ' SFDocuments.SF_Calc.SetCellStyle
2794 REM -----------------------------------------------------------------------------
2795 Public Function SetFormula(Optional ByVal TargetRange As Variant _
2796 , Optional ByRef Formula As Variant _
2797 ) As String
2798 ''' Set the given (array of) formulae in the given range
2799 ''' The full range is updated and the remainder of the sheet is left untouched
2800 ''' If the given formula is a string:
2801 ''' the unique formula is pasted across the whole range with adjustment of the relative references
2802 ''' Otherwise
2803 ''' If the size of Formula < the size of Range, then the other cells are emptied
2804 ''' If the size of Formula > the size of Range, then Formula is only partially copied
2805 ''' Vectors are always expanded vertically, except if the range has a height of exactly 1 row
2806 ''' Args:
2807 ''' TargetRange : the range as a string that should receive a new Formula
2808 ''' Formula: a scalar, a vector or an array with the new formula(e) as strings for each cell of the range.
2809 ''' Returns:
2810 ''' A string representing the updated range
2811 ''' Examples:
2813 ''' oDoc.SetFormula("A1:F1", Array("=A2", "=B2", "=C2+10")) ' Horizontal vector, partially empty
2814 ''' oDoc.SetFormula("A1:D2", "=E1") ' D2 contains the formula "=H2"
2816 Dim sSet As String ' Return value.XSpreadsheet.Name)
2817 Dim oAddress As Object ' Alias of TargetRange
2818 Dim vDataArray As Variant ' DataArray compatible with .DataArray UNO property
2822 If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
2823 sSet = ""
2825 Check:
2826 If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
2827 If Not _IsStillAlive() Then GoTo Finally
2828 If Not ScriptForge.SF_Utils._Validate(TargetRange, "TargetRange", Array(V_STRING, ScriptForge.V_OBJECT)) Then GoTo Finally
2829 If IsArray(Formula) Then
2830 If Not ScriptForge.SF_Utils._ValidateArray(Formula, "Formula", 0, V_STRING) Then GoTo Finally
2831 Else
2832 If Not ScriptForge.SF_Utils._Validate(Formula, "Formula", V_STRING) Then GoTo Finally
2833 End If
2834 End If
2836 Try:
2837 If VarType(TargetRange) = V_STRING Then Set oAddress = _ParseAddress(TargetRange) Else Set oAddress = TargetRange
2838 With oAddress
2839 If IsArray(Formula) Then
2840 ' Convert to data array and limit its size to the size of the initial range
2842 If UBound(vDataArray) < LBound(vDataArray) Then GoTo Finally
2843 .XCellRange.setFormulaArray(vDataArray)
2844 Else
2845 With .XCellRange
2846 ' Store formula in top-left cell and paste it along the whole range
2848 .fillSeries(com.sun.star.sheet.FillDirection.TO_BOTTOM, com.sun.star.sheet.FillMode.SIMPLE, 0, 0, 0)
2849 .fillSeries(com.sun.star.sheet.FillDirection.TO_RIGHT, com.sun.star.sheet.FillMode.SIMPLE, 0, 0, 0)
2850 End With
2851 End If
2852 sSet = .RangeName
2853 End With
2855 Finally:
2856 SetFormula = sSet
2857 ScriptForge.SF_Utils._ExitFunction(cstThisSub)
2858 Exit Function
2859 Catch:
2860 GoTo Finally
2861 End Function ' SFDocuments.SF_Calc.SetFormula
2863 REM -----------------------------------------------------------------------------
2864 Private Function SetProperty(Optional ByVal psProperty As String _
2865 , Optional ByVal pvValue As Variant _
2866 ) As Boolean
2867 ''' Set the new value of the named property
2868 ''' Args:
2869 ''' psProperty: the name of the property
2870 ''' pvValue: the new value of the given property
2871 ''' Returns:
2872 ''' True if successful
2874 Dim bSet As Boolean ' Return value
2875 Static oSession As Object ' Alias of SF_Session
2876 Dim cstThisSub As String
2879 If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
2880 bSet = False
2883 If IsMissing(pvValue) Then pvValue = Empty
2884 'ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) ' Validation done in Property Lets
2886 If IsNull(oSession) Then Set oSession = ScriptForge.SF_Services.CreateScriptService("Session")
2887 bSet = True
2888 Select Case UCase(psProperty)
2890 CurrentSelection = pvValue
2892 CustomProperties = pvValue
2894 Description = pvValue
2896 Keywords = pvValue
2898 Subject = pvValue
2900 Title = pvValue
2901 Case Else
2902 bSet = False
2903 End Select
2905 Finally:
2906 SetProperty = bSet
2907 'ScriptForge.SF_Utils._ExitFunction(cstThisSub)
2908 Exit Function
2909 Catch:
2910 GoTo Finally
2911 End Function ' SFDocuments.SF_Calc.SetProperty
2913 REM -----------------------------------------------------------------------------
2914 Public Function SetValue(Optional ByVal TargetRange As Variant _
2915 , Optional ByRef Value As Variant _
2916 ) As String
2917 ''' Set the given value in the given range
2918 ''' The full range is updated and the remainder of the sheet is left untouched
2919 ''' If the size of Value < the size of Range, then the other cells are emptied
2920 ''' If the size of Value > the size of Range, then Value is only partially copied
2921 ''' Vectors are always expanded vertically, except if the range has a height of exactly 1 row
2922 ''' Args:
2923 ''' TargetRange : the range as a string that should receive a new value
2924 ''' Value: a scalar, a vector or an array with the new values for each cell o.XSpreadsheet.Name)f the range.
2925 ''' The new values should be strings, numeric values or dates. Other types empty the corresponding cell
2926 ''' Returns:
2927 ''' A string representing the updated range
2928 ''' Examples:
2930 ''' oDoc.SetValue("A1:F1", Array(1, 2, 3)) ' Horizontal vector, partially empty
2931 ''' oDoc.SetValue("A1:D2", SF_Array.AppendRow(Array(1, 2, 3, 4), Array(5, 6, 7, 8)))
2933 Dim sSet As String ' Return value
2934 Dim oAddress As Object ' Alias of TargetRange
2935 Dim vDataArray As Variant ' DataArray compatible with .DataArray UNO property
2939 If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
2940 sSet = ""
2942 Check:
2943 If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
2944 If Not _IsStillAlive() Then GoTo Finally
2945 If Not ScriptForge.SF_Utils._Validate(TargetRange, "TargetRange", V_STRING) Then GoTo Finally
2946 If IsArray(Value) Then
2948 Else
2950 End If
2951 End If
2953 Try:
2954 Set oAddress = _ParseAddress(TargetRange)
2955 With oAddress
2956 ' Convert to data array and limit its size to the size of the initial range
2958 If UBound(vDataArray) < LBound(vDataArray) Then GoTo Finally
2959 .XCellRange.setDataArray(vDataArray)
2960 sSet = .RangeName
2961 End With
2963 Finally:
2964 SetValue = sSet
2965 ScriptForge.SF_Utils._ExitFunction(cstThisSub)
2966 Exit Function
2967 Catch:
2968 GoTo Finally
2969 End Function ' SFDocuments.SF_Calc.SetValue
2971 REM -----------------------------------------------------------------------------
2972 Public Function ShiftDown(Optional ByVal Range As Variant _
2973 , Optional ByVal WholeRow As Variant _
2974 , Optional ByVal Rows As Variant _
2975 ) As String
2976 ''' Move a specified range and all cells below in the same columns downwards by inserting empty cells
2977 ''' The inserted cells can span whole rows or be limited to the width of the range
2978 ''' The height of the inserted area is provided by the Rows argument
2979 ''' Nothing happens if the range shift crosses one of the edges of the worksheet
2980 ''' The execution of the method has no effect on the current selection
2981 ''' Args:
2982 ''' Range: the range above which cells have to be inserted, as a string
2983 ''' WholeRow: when True (default = False), insert whole rows
2984 ''' Rows: the height of the area to insert. Default = the height of the Range argument
2985 ''' Returns:
2986 ''' A string representing the new location of the initial range
2987 ''' Examples:
2988 ''' newrange = oDoc.ShiftDown("SheetX.A1:F10") ' "$SheetX.$A$11:$F$20"
2989 ''' newrange = oDoc.ShiftDown("SheetX.A1:F10", Rows := 3) ' "$SheetX.$A$4:$F$13"
2991 Dim sShift As String ' Return value
2992 Dim oSourceAddress As Object ' Alias of Range as _Address
2993 Dim lHeight As Long ' Range height
2994 Dim oShiftAddress As Object ' com.sun.star.table.CellRangeAddress - Range adjusted to the right width
2995 Dim lShiftMode As Long ' One of the com.sun.star.sheet.CellInsertMode enum values
3000 If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
3001 sShift = ""
3003 Check:
3004 If IsMissing(WholeRow) Or IsEmpty(WholeRow) Then WholeRow = False
3005 If IsMissing(Rows) Or IsEmpty(Rows) Then Rows = 0
3006 If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
3007 If Not _IsStillAlive(True) Then GoTo Finally
3009 If Not ScriptForge.SF_Utils._Validate(WholeRow, "WholeRow", ScriptForge.V_BOOLEAN) Then GoTo Finally
3010 If Not ScriptForge.SF_Utils._Validate(Rows, "Rows", ScriptForge.V_NUMERIC) Then GoTo Finally
3011 End If
3013 Try:
3014 Set oSourceAddress = _ParseAddress(Range)
3016 With oSourceAddress
3018 ' Manage the height of the area to shift
3019 ' The insertCells() method inserts a number of rows equal to the height of the cell range to shift
3020 lHeight = .Height
3023 If Rows <> lHeight Then
3025 Else
3026 Set oShiftAddress = .XCellRange.RangeAddress
3027 End If
3029 ' Determine the shift mode
3030 With com.sun.star.sheet.CellInsertMode
3031 If WholeRow Then lShiftMode = .ROWS Else lShiftMode = .DOWN
3032 End With
3034 ' Move the cells as requested. This modifies .XCellRange
3035 .XSpreadsheet.insertCells(oShiftAddress, lShiftMode)
3037 ' Determine the receiving area
3038 sShift = .XCellRange.AbsoluteName
3040 End With
3042 Finally:
3043 ShiftDown = sShift
3044 ScriptForge.SF_Utils._ExitFunction(cstThisSub)
3045 Exit Function
3046 Catch:
3047 ' When error, return the original range
3048 If Not IsNull(oSourceAddress) Then sShift = oSourceAddress.RangeName
3049 GoTo Finally
3050 End Function ' SFDocuments.SF_Calc.ShiftDown
3052 REM -----------------------------------------------------------------------------
3053 Public Function ShiftLeft(Optional ByVal Range As Variant _
3054 , Optional ByVal WholeColumn As Variant _
3055 , Optional ByVal Columns As Variant _
3056 ) As String
3057 ''' Delete the leftmost columns of a specified range and move all cells at their right leftwards
3058 ''' The deleted cells can span whole columns or be limited to the height of the range
3059 ''' The width of the deleted area is provided by the Columns argument
3060 ''' The execution of the method has no effect on the current selection
3061 ''' Args:
3062 ''' Range: the range in which cells have to be erased, as a string
3063 ''' WholeColumn: when True (default = False), erase whole columns
3064 ''' Columns: the width of the area to delete.
3065 ''' Default = the width of the Range argument, it is also its maximum value
3066 ''' Returns:
3067 ''' A string representing the location of the remaining part of the initial range,
3068 ''' or the zero-length string if the whole range has been deleted
3069 ''' Examples:
3070 ''' newrange = oDoc.ShiftLeft("SheetX.G1:L10") ' """
3071 ''' newrange = oDoc.ShiftLeft("SheetX.G1:L10", Columns := 3) ' "$SheetX.$G$1:$I$10"
3073 Dim sShift As String ' Return value
3074 Dim oSourceAddress As Object ' Alias of Range as _Address
3075 Dim lWidth As Long ' Range width
3076 Dim oShiftAddress As Object ' com.sun.star.table.CellRangeAddress - Range adjusted to the right width
3077 Dim lShiftMode As Long ' One of the com.sun.star.sheet.CellDeleteMode enum values
3082 If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
3083 sShift = ""
3085 Check:
3086 If IsMissing(WholeColumn) Or IsEmpty(WholeColumn) Then WholeColumn = False
3087 If IsMissing(Columns) Or IsEmpty(Columns) Then Columns = 0
3088 If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
3089 If Not _IsStillAlive(True) Then GoTo Finally
3091 If Not ScriptForge.SF_Utils._Validate(WholeColumn, "WholeColumn", ScriptForge.V_BOOLEAN) Then GoTo Finally
3092 If Not ScriptForge.SF_Utils._Validate(Columns, "Columns", ScriptForge.V_NUMERIC) Then GoTo Finally
3093 End If
3095 Try:
3096 Set oSourceAddress = _ParseAddress(Range)
3097 Set _LastParsedAddress = Nothing ' Range will be erased. Force re-parsing next time
3099 With oSourceAddress
3101 ' Manage the width of the area to delete
3102 ' The removeRange() method erases a number of columns equal to the width of the cell range to delete
3103 lWidth = .Width
3105 If Columns < lWidth Then
3107 Else ' Columns is capped at the range width
3108 Set oShiftAddress = .XCellRange.RangeAddress
3109 End If
3111 ' Determine the Delete mode
3112 With com.sun.star.sheet.CellDeleteMode
3113 If WholeColumn Then lShiftMode = .COLUMNS Else lShiftMode = .LEFT
3114 End With
3116 ' Move the cells as requested. This modifies .XCellRange
3117 .XSpreadsheet.removeRange(oShiftAddress, lShiftMode)
3119 ' Determine the remaining area
3120 If Columns < lWidth Then sShift = .XCellRange.AbsoluteName
3122 End With
3124 Finally:
3125 ShiftLeft = sShift
3126 ScriptForge.SF_Utils._ExitFunction(cstThisSub)
3127 Exit Function
3128 Catch:
3129 ' When error, return the original range
3130 If Not IsNull(oSourceAddress) Then sShift = oSourceAddress.RangeName
3131 GoTo Finally
3132 End Function ' SFDocuments.SF_Calc.ShiftLeft
3134 REM -----------------------------------------------------------------------------
3135 Public Function ShiftRight(Optional ByVal Range As Variant _
3136 , Optional ByVal WholeColumn As Variant _
3137 , Optional ByVal Columns As Variant _
3138 ) As String
3139 ''' Move a specified range and all next cells in the same rows to the right by inserting empty cells
3140 ''' The inserted cells can span whole columns or be limited to the height of the range
3141 ''' The width of the inserted area is provided by the Columns argument
3142 ''' Nothing happens if the range shift crosses one of the edges of the worksheet
3143 ''' The execution of the method has no effect on the current selection
3144 ''' Args:
3145 ''' Range: the range before which cells have to be inserted, as a string
3146 ''' WholeColumn: when True (default = False), insert whole columns
3147 ''' Columns: the width of the area to insert. Default = the width of the Range argument
3148 ''' Returns:
3149 ''' A string representing the new location of the initial range
3150 ''' Examples:
3151 ''' newrange = oDoc.ShiftRight("SheetX.A1:F10") ' "$SheetX.$G$1:$L$10"
3152 ''' newrange = oDoc.ShiftRight("SheetX.A1:F10", Columns := 3) ' "$SheetX.$D$1:$I$10"
3154 Dim sShift As String ' Return value
3155 Dim oSourceAddress As Object ' Alias of Range as _Address
3156 Dim lWidth As Long ' Range width
3157 Dim oShiftAddress As Object ' com.sun.star.table.CellRangeAddress - Range adjusted to the right width
3158 Dim lShiftMode As Long ' One of the com.sun.star.sheet.CellInsertMode enum values
3163 If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
3164 sShift = ""
3166 Check:
3167 If IsMissing(WholeColumn) Or IsEmpty(WholeColumn) Then WholeColumn = False
3168 If IsMissing(Columns) Or IsEmpty(Columns) Then Columns = 0
3169 If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
3170 If Not _IsStillAlive(True) Then GoTo Finally
3172 If Not ScriptForge.SF_Utils._Validate(WholeColumn, "WholeColumn", ScriptForge.V_BOOLEAN) Then GoTo Finally
3173 If Not ScriptForge.SF_Utils._Validate(Columns, "Columns", ScriptForge.V_NUMERIC) Then GoTo Finally
3174 End If
3176 Try:
3177 Set oSourceAddress = _ParseAddress(Range)
3179 With oSourceAddress
3181 ' Manage the width of the area to Shift
3182 ' The insertCells() method inserts a number of columns equal to the width of the cell range to Shift
3183 lWidth = .Width
3186 If Columns <> lWidth Then
3188 Else
3189 Set oShiftAddress = .XCellRange.RangeAddress
3190 End If
3192 ' Determine the Shift mode
3193 With com.sun.star.sheet.CellInsertMode
3194 If WholeColumn Then lShiftMode = .COLUMNS Else lShiftMode = .RIGHT
3195 End With
3197 ' Move the cells as requested. This modifies .XCellRange
3198 .XSpreadsheet.insertCells(oShiftAddress, lShiftMode)
3200 ' Determine the receiving area
3201 sShift = .XCellRange.AbsoluteName
3203 End With
3205 Finally:
3206 ShiftRight = sShift
3207 ScriptForge.SF_Utils._ExitFunction(cstThisSub)
3208 Exit Function
3209 Catch:
3210 ' When error, return the original range
3211 If Not IsNull(oSourceAddress) Then sShift = oSourceAddress.RangeName
3212 GoTo Finally
3213 End Function ' SFDocuments.SF_Calc.ShiftRight
3215 REM -----------------------------------------------------------------------------
3216 Public Function ShiftUp(Optional ByVal Range As Variant _
3217 , Optional ByVal WholeRow As Variant _
3218 , Optional ByVal Rows As Variant _
3219 ) As String
3220 ''' Delete the topmost rows of a specified range and move all cells below upwards
3221 ''' The deleted cells can span whole rows or be limited to the width of the range
3222 ''' The height of the deleted area is provided by the Rows argument
3223 ''' The execution of the method has no effect on the current selection
3224 ''' Args:
3225 ''' Range: the range in which cells have to be erased, as a string
3226 ''' WholeRow: when True (default = False), erase whole rows
3227 ''' Rows: the height of the area to delete.
3228 ''' Default = the height of the Range argument, it is also its maximum value
3229 ''' Returns:
3230 ''' A string representing the location of the remaining part of the initial range,
3231 ''' or the zero-length string if the whole range has been deleted
3232 ''' Examples:
3234 ''' newrange = oDoc.ShiftUp("SheetX.G1:L10", Rows := 3) ' "$SheetX.$G$1:$I$10"
3236 Dim sShift As String ' Return value
3237 Dim oSourceAddress As Object ' Alias of Range as _Address
3238 Dim lHeight As Long ' Range height
3239 Dim oShiftAddress As Object ' com.sun.star.table.CellRangeAddress - Range adjusted to the right height
3240 Dim lShiftMode As Long ' One of the com.sun.star.sheet.CellDeleteMode enum values
3245 If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
3246 sShift = ""
3248 Check:
3249 If IsMissing(WholeRow) Or IsEmpty(WholeRow) Then WholeRow = False
3250 If IsMissing(Rows) Or IsEmpty(Rows) Then Rows = 0
3251 If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
3252 If Not _IsStillAlive(True) Then GoTo Finally
3254 If Not ScriptForge.SF_Utils._Validate(WholeRow, "WholeRow", ScriptForge.V_BOOLEAN) Then GoTo Finally
3255 If Not ScriptForge.SF_Utils._Validate(Rows, "Rows", ScriptForge.V_NUMERIC) Then GoTo Finally
3256 End If
3258 Try:
3259 Set oSourceAddress = _ParseAddress(Range)
3260 Set _LastParsedAddress = Nothing ' Range will be erased. Force re-parsing next time
3262 With oSourceAddress
3264 ' Manage the height of the area to delete
3265 ' The removeRange() method erases a number of rows equal to the height of the cell range to delete
3266 lHeight = .Height
3268 If Rows < lHeight Then
3270 Else ' Rows is capped at the range height
3271 Set oShiftAddress = .XCellRange.RangeAddress
3272 End If
3274 ' Determine the Delete mode
3275 With com.sun.star.sheet.CellDeleteMode
3276 If WholeRow Then lShiftMode = .ROWS Else lShiftMode = .UP
3277 End With
3279 ' Move the cells as requested. This modifies .XCellRange
3280 .XSpreadsheet.removeRange(oShiftAddress, lShiftMode)
3282 ' Determine the remaining area
3283 If Rows < lHeight Then sShift = .XCellRange.AbsoluteName
3285 End With
3287 Finally:
3288 ShiftUp = sShift
3289 ScriptForge.SF_Utils._ExitFunction(cstThisSub)
3290 Exit Function
3291 Catch:
3292 ' When error, return the original range
3293 If Not IsNull(oSourceAddress) Then sShift = oSourceAddress.RangeName
3294 GoTo Finally
3295 End Function ' SFDocuments.SF_Calc.ShiftUp
3297 REM -----------------------------------------------------------------------------
3298 Public Function SortRange(Optional ByVal Range As Variant _
3299 , Optional ByVal SortKeys As Variant _
3300 , Optional ByVal SortOrder As Variant _
3301 , Optional ByVal DestinationCell As Variant _
3302 , Optional ByVal ContainsHeader As Variant _
3303 , Optional ByVal CaseSensitive As Variant _
3304 , Optional ByVal SortColumns As Variant _
3305 ) As Variant
3306 ''' Sort the given range on maximum 3 columns/rows. The sorting order may vary by column/row
3307 ''' Args:
3308 ''' Range: the range to sort as a string
3309 ''' SortKeys: a scalar (if 1 column/row) or an array of column/row numbers starting from 1
3310 ''' SortOrder: a scalar or an array of strings: "ASC" or "DESC"
3311 ''' Each item is paired with the corresponding item in SortKeys
3312 ''' If the SortOrder array is shorter than SortKeys, the remaining keys are sorted
3313 ''' in ascending order
3314 ''' DestinationCell: the destination of the sorted range of cells, as a string
3315 ''' If given as range, the destination will be reduced to its top-left cell
3316 ''' By default, Range is overwritten with its sorted content
3317 ''' ContainsHeader: when True, the first row/column is not sorted. Default = False
3318 ''' CaseSensitive: only for string comparisons, default = False
3319 ''' SortColumns: when True, the columns are sorted from left to right
3320 ''' Default = False: rows are sorted from top to bottom.
3321 ''' Returns:
3322 ''' The modified range of cells as a string
3323 ''' Example:
3324 ''' oDoc.SortRange("A2:J200", Array(1, 3), , Array("ASC", "DESC"), CaseSensitive := True)
3325 ''' ' Sort on columns A (ascending) and C (descending)
3327 Dim sSort As String ' Return value
3328 Dim oRangeAddress As _Address ' Parsed range
3329 Dim oRange As Object ' com.sun.star.table.XCellRange
3330 Dim oDestRange As Object ' Destination as a range
3331 Dim oDestAddress As Object ' com.sun.star.table.CellRangeAddress
3332 Dim oDestCell As Object ' com.sun.star.table.CellAddress
3333 Dim vSortDescriptor As Variant ' Array of com.sun.star.beans.PropertyValue
3334 Dim vSortFields As Variant ' Array of com.sun.star.table.TableSortField
3335 Dim sOrder As String ' Item in SortOrder
3336 Dim i As Long
3338 Const cstSubArgs = "Range, SortKeys, [TargetRange=""""], [SortOrder=""ASC""], [DestinationCell=""""], [ContainsHeader=False], [CaseSensitive=False], [SortColumns=False]"
3340 If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
3341 sSort = ""
3343 Check:
3344 If IsMissing(SortKeys) Or IsEmpty(SortKeys) Then
3345 SortKeys = Array(1)
3346 ElseIf Not IsArray(SortKeys) Then
3347 SortKeys = Array(SortKeys)
3348 End If
3349 If IsMissing(DestinationCell) Or IsEmpty(DestinationCell) Then DestinationCell = ""
3350 If IsMissing(SortOrder) Or IsEmpty(SortOrder) Then
3352 ElseIf Not IsArray(SortOrder) Then
3353 SortOrder = Array(SortOrder)
3354 End If
3355 If IsMissing(ContainsHeader) Or IsEmpty(ContainsHeader) Then ContainsHeader = False
3356 If IsMissing(CaseSensitive) Or IsEmpty(CaseSensitive) Then CaseSensitive = False
3357 If IsMissing(SortColumns) Or IsEmpty(SortColumns) Then SortColumns = False
3358 If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
3359 If Not _IsStillAlive() Then GoTo Finally
3361 If Not ScriptForge.SF_Utils._ValidateArray(SortKeys, "SortKeys", 1, V_NUMERIC, True) Then GoTo Finally
3362 If Not ScriptForge.SF_Utils._Validate(DestinationCell, "DestinationCell", V_STRING) Then GoTo Finally
3363 If Not ScriptForge.SF_Utils._ValidateArray(SortOrder, "SortOrder", 1, V_STRING, True) Then GoTo Finally
3364 If Not ScriptForge.SF_Utils._Validate(ContainsHeader, "ContainsHeader", ScriptForge.V_BOOLEAN) Then GoTo Finally
3365 If Not ScriptForge.SF_Utils._Validate(CaseSensitive, "CaseSensitive", ScriptForge.V_BOOLEAN) Then GoTo Finally
3366 If Not ScriptForge.SF_Utils._Validate(SortColumns, "SortColumns", ScriptForge.V_BOOLEAN) Then GoTo Finally
3367 End If
3368 Set oRangeAddress = _ParseAddress(Range)
3371 Try:
3372 ' Initialize the sort descriptor
3373 Set oRange = oRangeAddress.XCellRange
3374 vSortDescriptor = oRange.createSortDescriptor
3375 vSortDescriptor = ScriptForge.SF_Utils._SetPropertyValue(vSortDescriptor, "IsSortColumns", SortColumns)
3376 vSortDescriptor = ScriptForge.SF_Utils._SetPropertyValue(vSortDescriptor, "ContainsHeader", ContainsHeader)
3377 vSortDescriptor = ScriptForge.SF_Utils._SetPropertyValue(vSortDescriptor, "BindFormatsToContent", True)
3378 If Len(DestinationCell) = 0 Then
3379 vSortDescriptor = ScriptForge.SF_Utils._SetPropertyValue(vSortDescriptor, "CopyOutputData", False)
3380 Else
3381 Set oDestAddress = oDestRange.XCellRange.RangeAddress
3382 Set oDestCell = New com.sun.star.table.CellAddress
3383 With oDestAddress
3384 oDestCell.Sheet = .Sheet
3385 oDestCell.Column = .StartColumn
3386 oDestCell.Row = .StartRow
3387 End With
3388 vSortDescriptor = ScriptForge.SF_Utils._SetPropertyValue(vSortDescriptor, "CopyOutputData", True)
3389 vSortDescriptor = ScriptForge.SF_Utils._SetPropertyValue(vSortDescriptor, "OutputPosition", oDestCell)
3390 End If
3391 vSortDescriptor = ScriptForge.SF_Utils._SetPropertyValue(vSortDescriptor, "IsUserListEnabled", False)
3393 ' Define the sorting keys
3394 vSortFields = Array()
3395 ReDim vSortFields(0 To UBound(SortKeys))
3396 For i = 0 To UBound(SortKeys)
3397 vSortFields(i) = New com.sun.star.table.TableSortField
3400 With vSortFields(i)
3401 .Field = SortKeys(i) - 1
3403 .IsCaseSensitive = CaseSensitive
3404 End With
3405 Next i
3407 ' Associate the keys and the descriptor, and sort
3408 vSortDescriptor = ScriptForge.SF_Utils._SetPropertyValue(vSortDescriptor, "SortFields", vSortFields)
3409 oRange.sort(vSortDescriptor)
3411 ' Compute the changed area
3412 If Len(DestinationCell) = 0 Then
3413 sSort = oRangeAddress.RangeName
3414 Else
3415 With oRangeAddress
3417 End With
3418 End If
3420 Finally:
3421 SortRange = sSort
3422 ScriptForge.SF_Utils._ExitFunction(cstThisSub)
3423 Exit Function
3424 Catch:
3425 GoTo Finally
3426 End Function ' SFDocuments.SF_Calc.SortRange
3428 REM ======================================================= SUPERCLASS PROPERTIES
3430 REM -----------------------------------------------------------------------------
3431 Property Get CustomProperties() As Variant
3433 End Property ' SFDocuments.SF_Calc.CustomProperties
3435 REM -----------------------------------------------------------------------------
3436 Property Let CustomProperties(Optional ByVal pvCustomProperties As Variant)
3437 [_Super].CustomProperties = pvCustomProperties
3438 End Property ' SFDocuments.SF_Calc.CustomProperties
3440 REM -----------------------------------------------------------------------------
3441 Property Get Description() As Variant
3443 End Property ' SFDocuments.SF_Calc.Description
3445 REM -----------------------------------------------------------------------------
3446 Property Let Description(Optional ByVal pvDescription As Variant)
3447 [_Super].Description = pvDescription
3448 End Property ' SFDocuments.SF_Calc.Description
3450 REM -----------------------------------------------------------------------------
3451 Property Get DocumentProperties() As Variant
3453 End Property ' SFDocuments.SF_Calc.DocumentProperties
3455 REM -----------------------------------------------------------------------------
3456 Property Get DocumentType() As String
3458 End Property ' SFDocuments.SF_Calc.DocumentType
3460 REM -----------------------------------------------------------------------------
3461 Property Get ExportFilters() As Variant
3463 End Property ' SFDocuments.SF_Calc.ExportFilters
3465 REM -----------------------------------------------------------------------------
3466 Property Get ImportFilters() As Variant
3468 End Property ' SFDocuments.SF_Calc.ImportFilters
3470 REM -----------------------------------------------------------------------------
3471 Property Get IsBase() As Boolean
3473 End Property ' SFDocuments.SF_Calc.IsBase
3475 REM -----------------------------------------------------------------------------
3476 Property Get IsCalc() As Boolean
3478 End Property ' SFDocuments.SF_Calc.IsCalc
3480 REM -----------------------------------------------------------------------------
3481 Property Get IsDraw() As Boolean
3483 End Property ' SFDocuments.SF_Calc.IsDraw
3485 REM -----------------------------------------------------------------------------
3486 Property Get IsImpress() As Boolean
3488 End Property ' SFDocuments.SF_Calc.IsImpress
3490 REM -----------------------------------------------------------------------------
3491 Property Get IsMath() As Boolean
3493 End Property ' SFDocuments.SF_Calc.IsMath
3495 REM -----------------------------------------------------------------------------
3496 Property Get IsWriter() As Boolean
3498 End Property ' SFDocuments.SF_Calc.IsWriter
3500 REM -----------------------------------------------------------------------------
3501 Property Get Keywords() As Variant
3503 End Property ' SFDocuments.SF_Calc.Keywords
3505 REM -----------------------------------------------------------------------------
3506 Property Let Keywords(Optional ByVal pvKeywords As Variant)
3507 [_Super].Keywords = pvKeywords
3508 End Property ' SFDocuments.SF_Calc.Keywords
3510 REM -----------------------------------------------------------------------------
3511 Property Get Readonly() As Variant
3513 End Property ' SFDocuments.SF_Calc.Readonly
3515 REM -----------------------------------------------------------------------------
3516 Property Get Subject() As Variant
3518 End Property ' SFDocuments.SF_Calc.Subject
3520 REM -----------------------------------------------------------------------------
3521 Property Let Subject(Optional ByVal pvSubject As Variant)
3522 [_Super].Subject = pvSubject
3523 End Property ' SFDocuments.SF_Calc.Subject
3525 REM -----------------------------------------------------------------------------
3526 Property Get Title() As Variant
3528 End Property ' SFDocuments.SF_Calc.Title
3530 REM -----------------------------------------------------------------------------
3531 Property Let Title(Optional ByVal pvTitle As Variant)
3532 [_Super].Title = pvTitle
3533 End Property ' SFDocuments.SF_Calc.Title
3535 REM -----------------------------------------------------------------------------
3536 Property Get XComponent() As Variant
3538 End Property ' SFDocuments.SF_Calc.XComponent
3540 REM ========================================================== SUPERCLASS METHODS
3542 REM -----------------------------------------------------------------------------
3543 'Public Function Activate() As Boolean
3544 ' Activate = [_Super].Activate()
3547 REM -----------------------------------------------------------------------------
3548 Public Function CloseDocument(Optional ByVal SaveAsk As Variant) As Boolean
3549 CloseDocument = [_Super].CloseDocument(SaveAsk)
3550 End Function ' SFDocuments.SF_Calc.CloseDocument
3552 REM -----------------------------------------------------------------------------
3553 Public Function CreateMenu(Optional ByVal MenuHeader As Variant _
3554 , Optional ByVal Before As Variant _
3555 , Optional ByVal SubmenuChar As Variant _
3556 ) As Object
3557 Set CreateMenu = [_Super].CreateMenu(MenuHeader, Before, SubmenuChar)
3558 End Function ' SFDocuments.SF_Calc.CreateMenu
3560 REM -----------------------------------------------------------------------------
3561 Public Function ExportAsPDF(Optional ByVal FileName As Variant _
3562 , Optional ByVal Overwrite As Variant _
3563 , Optional ByVal Pages As Variant _
3564 , Optional ByVal Password As Variant _
3565 , Optional ByVal Watermark As Variant _
3566 ) As Boolean
3567 ExportAsPDF = [_Super].ExportAsPDF(FileName, Overwrite, Pages, Password, Watermark)
3568 End Function ' SFDocuments.SF_Calc.ExportAsPDF
3570 REM -----------------------------------------------------------------------------
3571 Public Function RemoveMenu(Optional ByVal MenuHeader As Variant) As Boolean
3572 RemoveMenu = [_Super].RemoveMenu(MenuHeader)
3573 End Function ' SFDocuments.SF_Calc.RemoveMenu
3575 REM -----------------------------------------------------------------------------
3576 Public Sub RunCommand(Optional ByVal Command As Variant _
3577 , ParamArray Args As Variant _
3578 )
3579 [_Super].RunCommand(Command, Args)
3580 End Sub ' SFDocuments.SF_Calc.RunCommand
3582 REM -----------------------------------------------------------------------------
3583 Public Function Save() As Boolean
3584 Save = [_Super].Save()
3585 End Function ' SFDocuments.SF_Calc.Save
3587 REM -----------------------------------------------------------------------------
3588 Public Function SaveAs(Optional ByVal FileName As Variant _
3589 , Optional ByVal Overwrite As Variant _
3590 , Optional ByVal Password As Variant _
3591 , Optional ByVal FilterName As Variant _
3592 , Optional ByVal FilterOptions As Variant _
3593 ) As Boolean
3594 SaveAs = [_Super].SaveAs(FileName, Overwrite, Password, FilterName, FilterOptions)
3595 End Function ' SFDocuments.SF_Calc.SaveAs
3597 REM -----------------------------------------------------------------------------
3598 Public Function SaveCopyAs(Optional ByVal FileName As Variant _
3599 , Optional ByVal Overwrite As Variant _
3600 , Optional ByVal Password As Variant _
3601 , Optional ByVal FilterName As Variant _
3602 , Optional ByVal FilterOptions As Variant _
3603 ) As Boolean
3604 SaveCopyAs = [_Super].SaveCopyAs(FileName, Overwrite, Password, FilterName, FilterOptions)
3605 End Function ' SFDocuments.SF_Calc.SaveCopyAs
3607 REM -----------------------------------------------------------------------------
3608 Public Function SetPrinter(Optional ByVal Printer As Variant _
3609 , Optional ByVal Orientation As Variant _
3610 , Optional ByVal PaperFormat As Variant _
3611 ) As Boolean
3612 SetPrinter = [_Super].SetPrinter(Printer, Orientation, PaperFormat)
3613 End Function ' SFDocuments.SF_Calc.SetPrinter
3615 REM =========================================================== PRIVATE FUNCTIONS
3617 REM -----------------------------------------------------------------------------
3618 Private Sub _ClearRange(ByVal psTarget As String _
3619 , Optional ByVal Range As Variant _
3620 , Optional FilterFormula As Variant _
3621 , Optional FilterScope As Variant _
3622 )
3623 ''' Clear the given range with the given options
3624 ''' The range may be filtered by a formula for a selective clearance
3625 ''' Arguments checking is done in this Sub, not in the calling one
3626 ''' Args:
3628 ''' Range: the range to clear as a string
3629 ''' FilterFormula: a selection of cells based on a Calc formula
3630 ''' When left empty, all the cells of the range are cleared
3633 Dim lClear As Long ' A combination of com.sun.star.sheet.CellFlags
3634 Dim oRange As Object ' Alias of Range
3635 Dim vRanges() As Variant ' Array of subranges resulting from the application of the filter
3636 Dim i As Long
3639 Const cstSubArgs = "Range, [FilterFormula=""], [FilterScope=""CELL""|""ROW""|""COLUMN""]"
3641 If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
3643 Check:
3644 If IsMissing(FilterFormula) Or IsEmpty(FilterFormula) Then FilterFormula = ""
3646 If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
3647 If Not _IsStillAlive() Then GoTo Finally
3648 If Not ScriptForge.SF_Utils._Validate(Range, "Range", Array(V_STRING, ScriptForge.V_OBJECT)) Then GoTo Finally
3649 If Not ScriptForge.SF_Utils._Validate(FilterFormula, "FilterFormula", V_STRING) Then GoTo Finally
3651 If Not ScriptForge.SF_Utils._Validate(FilterScope, "FilterScope", V_STRING, Array("CELL", "ROW", "COLUMN")) Then GoTo Finally
3652 Else
3653 If Not ScriptForge.SF_Utils._Validate(FilterScope, "FilterScope", V_STRING) Then GoTo Finally
3654 End If
3655 End If
3657 Try:
3658 With com.sun.star.sheet.CellFlags
3659 Select Case psTarget
3661 lClear = .VALUE + .DATETIME + .STRING + .ANNOTATION + .FORMULA _
3662 + .HARDATTR + .STYLES + .OBJECTS + .EDITATTR + .FORMATTED
3664 lClear = .HARDATTR + .STYLES + .EDITATTR + .FORMATTED
3666 lClear = .VALUE + .DATETIME + .STRING + .FORMULA
3667 End Select
3668 End With
3670 If VarType(Range) = V_STRING Then Set oRange = _ParseAddress(Range) Else Set oRange = Range
3672 ' Without filter, the whole range is cleared
3673 ' Otherwise the filter cuts the range in subranges and clears them one by one
3674 If Len(FilterFormula) = 0 Then
3675 oRange.XCellRange.clearContents(lClear)
3676 Else
3677 vRanges() = _ComputeFilter(oRange, FilterFormula, UCase(FilterScope))
3678 For i = 0 To UBound(vRanges)
3679 vRanges(i).XCellRange.clearContents(lClear)
3680 Next i
3681 End If
3683 Finally:
3684 ScriptForge.SF_Utils._ExitFunction(cstThisSub)
3685 Exit Sub
3686 Catch:
3687 GoTo Finally
3688 End Sub ' SFDocuments.SF_Calc._ClearRange
3690 REM -----------------------------------------------------------------------------
3691 Private Function _ComputeFilter(ByRef poRange As Object _
3692 , ByVal psFilterFormula As String _
3693 , ByVal psFilterScope As String _
3694 ) As Variant
3695 ''' Compute in the given range the cells, rows or columns for which
3696 ''' the given formula returns TRUE
3697 ''' Args:
3698 ''' poRange: the range on which to compute the filter as an _Address type
3699 ''' psFilterFormula: the formula to be applied on each row, column or cell
3701 ''' Returns:
3702 ''' An array of ranges as objects of type _Address
3704 Dim vRanges As Variant ' Return value
3705 Dim oRange As Object ' A single vRanges() item
3706 Dim lLast As Long ' Last used row or column number in the sheet containing Range
3707 Dim oFormulaRange As _Address ' Range where the FilterFormula must be stored
3708 Dim sFormulaDirection As String ' Either V(ertical), H(orizontal) or B(oth)
3709 Dim vDataArray As Variant ' DataArray compatible with .DataArray UNO property
3710 Dim vFilter As Variant ' Array of Boolean values indicating which rows should be erased
3711 Dim bFilter As Boolean ' A single item in vFilter
3712 Dim iDims As Integer ' Number of dimensions of vFilter()
3713 Dim lLower As Long ' Lower level of contiguous True filter values
3714 Dim lUpper As Long ' Upper level of contiguous True filter values
3715 Dim i As Long, j As Long
3717 Check:
3718 ' Error handling is determined by the calling method
3719 vRanges = Array()
3721 Try:
3722 With poRange
3724 ' Compute the range where to apply the formula
3725 ' Determine the direction of the range containing the formula vertical, horizontal or both
3726 Select Case psFilterScope
3728 lLast = LastColumn(.SheetName)
3729 ' Put formulas as a single column in the unused area at the right of the range to filter
3730 Set oFormulaRange = _Offset(poRange, 0, lLast - .XCellRange.RangeAddress.StartColumn + 1, 0, 1)
3733 lLast = LastRow(.SheetName)
3734 ' Put formulas as a single row in the unused area at the bottom of the range to filter
3738 lLast = LastRow(.SheetName)
3739 ' Put formulas as a matrix in the unused area at the bottom of the range to filter
3742 If oFormulaRange.Width = 1 Then
3744 ElseIf oFormulaRange.Height = 1 Then
3746 End If
3747 End Select
3749 ' Apply the formula and get the result as an array of Boolean values. Clean up
3750 SetFormula(oFormulaRange, psFilterFormula)
3751 vDataArray = oFormulaRange.XCellRange.getDataArray()
3752 vFilter = _ConvertFromDataArray(vDataArray)
3753 iDims = ScriptForge.SF_Array.CountDims(vFilter)
3754 ClearAll(oFormulaRange)
3757 Select Case iDims
3759 If vFilter = 1 Then vRanges = ScriptForge.SF_Array.Append(vRanges, poRange)
3761 ' Nothing to do
3763 ' Strategy: group contiguous applicable rows/columns to optimize heavy operations like CompactUp, CompactLeft
3764 ' Stack the contiguous ranges of True values in vRanges()
3766 ' To manage vector and array with same code, setup a single fictitious loop when vector, otherwise scan array by row
3770 For j = 0 To UBound(vFilter, iDims)
3771 If iDims = 1 Then bFilter = CBool(vFilter(j)) Else bFilter = CBool(vFilter(i, j))
3774 lUpper = j
3775 ElseIf Not bFilter Then
3777 ElseIf bFilter Then
3779 End If
3780 ' Determine the next applicable range when one found and limit reached
3786 Else ' CELL
3788 End If
3789 If Not IsNull(oRange) Then vRanges = ScriptForge.SF_Array.Append(vRanges, oRange)
3791 End If
3792 Next j
3794 Next i
3795 Case Else
3796 ' Should not happen
3797 End Select
3799 End With
3801 Finally:
3802 _ComputeFilter = vRanges()
3803 Exit Function
3804 End Function ' SFDocuments.SF_Calc._ComputeFilter
3806 REM -----------------------------------------------------------------------------
3807 Public Function _ConvertFromDataArray(ByRef pvDataArray As Variant) As Variant
3809 ''' Args:
3810 ''' pvDataArray: an array as returned by the XCellRange.getDataArray or .getFormulaArray methods
3811 ''' Returns:
3812 ''' A scalar, a zero-based 1D array or a zero-based 2D array of strings and/or doubles
3813 ''' To convert doubles to dates, use the CDate builtin function
3815 Dim vArray As Variant ' Return value
3816 Dim lMax1 As Long ' UBound of pvDataArray
3817 Dim lMax2 As Long ' UBound of pvDataArray items
3818 Dim i As Long
3819 Dim j As Long
3821 vArray = Empty
3823 Try:
3824 ' Convert the data array to scalar, vector or array
3825 lMax1 = UBound(pvDataArray)
3827 lMax2 = UBound(pvDataArray(0))
3830 Select Case True
3834 ReDim vArray(0 To lMax1)
3835 For i = 0 To lMax1
3836 vArray(i) = pvDataArray(i)(0)
3837 Next i
3839 ReDim vArray(0 To lMax2)
3840 For j = 0 To lMax2
3841 vArray(j) = pvDataArray(0)(j)
3842 Next j
3843 Case Else ' Array
3845 For i = 0 To lMax1
3846 For j = 0 To lMax2
3847 vArray(i, j) = pvDataArray(i)(j)
3848 Next j
3849 Next i
3850 End Select
3851 End If
3852 End If
3854 Finally:
3855 _ConvertFromDataArray = vArray
3856 End Function ' SFDocuments.SF_Calc._ConvertFromDataArray
3858 REM -----------------------------------------------------------------------------
3859 Private Function _ConvertToCellValue(ByVal pvItem As Variant) As Variant
3860 ''' Convert the argument to a valid Calc cell content
3862 Dim vCell As Variant ' Return value
3864 Try:
3865 Select Case ScriptForge.SF_Utils._VarTypeExt(pvItem)
3866 Case V_STRING : vCell = pvItem
3867 Case V_DATE : vCell = CDbl(pvItem)
3868 Case ScriptForge.V_NUMERIC : vCell = CDbl(pvItem)
3870 Case Else : vCell = ""
3871 End Select
3873 Finally:
3874 _ConvertToCellValue = vCell
3875 Exit Function
3876 End Function ' SFDocuments.SF_Calc._ConvertToCellValue
3878 REM -----------------------------------------------------------------------------
3879 Private Function _ConvertToDataArray(ByRef pvArray As Variant _
3880 , Optional ByVal plRows As Long _
3881 , Optional ByVal plColumns As Long _
3882 ) As Variant
3883 ''' Create a 2-dimensions nested array (compatible with the ranges .DataArray property)
3885 ''' Input may be a 1D array of arrays, typically when call issued by a Python script
3886 ''' Array items are converted to (possibly empty) strings or doubles
3887 ''' Args:
3888 ''' pvArray: the input scalar or array. If array, must be 1 or 2D otherwise it is ignored.
3889 ''' plRows, plColumns: the upper bounds of the data array
3890 ''' If bigger than input array, fill with zero-length strings
3891 ''' If smaller than input array, truncate
3892 ''' If plRows = 0 and the input array is a vector, the data array is aligned horizontally
3893 ''' They are either both present or both absent
3894 ''' When absent
3895 ''' The size of the output is fully determined by the input array
3896 ''' Vectors are aligned vertically
3897 ''' Returns:
3898 ''' A data array compatible with ranges .DataArray property
3899 ''' The output is always an array of nested arrays
3901 Dim vDataArray() As Variant ' Return value
3903 Dim vItem As Variant ' A single input item
3904 Dim iDims As Integer ' Number of dimensions of the input argument
3909 Dim lRows As Long ' Upper bound of vDataArray
3910 Dim lCols As Long ' Upper bound of vVector
3911 Dim bHorizontal As Boolean ' Horizontal vector
3912 Dim bDataArray As Boolean ' Input array is already an array of arrays
3913 Dim i As Long
3914 Dim j As Long
3916 Const cstEmpty = "" ' Empty cell
3918 If IsMissing(plRows) Or IsEmpty(plRows) Then plRows = -1
3919 If IsMissing(plColumns) Or IsEmpty(plColumns) Then plColumns = -1
3921 vDataArray = Array()
3923 Try:
3924 ' Check the input argument and know its boundaries
3925 iDims = ScriptForge.SF_Array.CountDims(pvArray)
3929 Select Case iDims
3931 Case 1
3933 bDataArray = IsArray(pvArray(0))
3934 If Not bDataArray Then
3935 If Not bHorizontal Then
3936 lMin1 = LBound(pvArray) : lMax1 = UBound(pvArray)
3937 Else
3938 lMin2 = LBound(pvArray) : lMax2 = UBound(pvArray)
3939 End If
3940 Else
3941 iDims = 2
3942 lMin1 = LBound(pvArray) : lMax1 = UBound(pvArray)
3944 End If
3945 Case 2
3948 End Select
3950 ' Set the output dimensions accordingly
3952 lRows = plRows
3953 lCols = plColumns
3954 Else ' Dimensions of output determined by input argument
3956 Select Case iDims
3959 lRows = lMax1 - lMin1
3960 Case 2
3961 lRows = lMax1 - lMin1
3962 lCols = lMax2 - lMin2
3963 End Select
3964 End If
3965 ReDim vDataArray(0 To lRows)
3967 ' Feed the output array row by row, each row being a vector
3968 For i = 0 To lRows
3969 ReDim vVector(0 To lCols)
3970 For j = 0 To lCols
3971 If i > lMax1 - lMin1 Then
3972 vVector(j) = cstEmpty
3973 ElseIf j > lMax2 - lMin2 Then
3974 vVector(j) = cstEmpty
3975 Else
3976 Select Case iDims
3977 Case -1 : vItem = _ConvertToCellValue(pvArray)
3978 Case 1
3979 If bHorizontal Then
3980 vItem = _ConvertToCellValue(pvArray(j + lMin2))
3981 Else
3982 vItem = _ConvertToCellValue(pvArray(i + lMin1))
3983 End If
3984 Case 2
3985 If bDataArray Then
3986 vItem = _ConvertToCellValue(pvArray(i + lMin1)(j + lMin2))
3987 Else
3988 vItem = _ConvertToCellValue(pvArray(i + lMin1, j + lMin2))
3989 End If
3990 End Select
3991 vVector(j) = vItem
3992 End If
3993 vDataArray(i) = vVector
3994 Next j
3995 Next i
3997 Finally:
3998 _ConvertToDataArray = vDataArray
3999 Exit Function
4000 End Function ' SFDocuments.SF_Calc._ConvertToDataArray
4002 REM -----------------------------------------------------------------------------
4003 Private Function _DFunction(ByVal psFunction As String _
4004 , Optional ByVal Range As Variant _
4005 ) As Double
4006 ''' Apply the given function on all the numeric values stored in the given range
4007 ''' Args:
4008 ''' Range : the range as a string where to apply the function on
4009 ''' Returns:
4010 ''' The resulting value as a double
4012 Dim dblGet As Double ' Return value
4013 Dim oAddress As Object ' Alias of Range
4014 Dim vFunction As Variant ' com.sun.star.sheet.GeneralFunction.XXX
4018 If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
4019 dblGet = 0
4021 Check:
4022 If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
4023 If Not _IsStillAlive() Then GoTo Finally
4025 End If
4027 Try:
4028 ' Get the data
4029 Set oAddress = _ParseAddress(Range)
4030 Select Case psFunction
4036 Case Else : GoTo Finally
4037 End Select
4038 dblGet = oAddress.XCellRange.computeFunction(vFunction)
4040 Finally:
4041 _DFunction = dblGet
4042 ScriptForge.SF_Utils._ExitFunction(cstThisSub)
4043 Exit Function
4044 Catch:
4045 GoTo Finally
4046 End Function ' SFDocuments.SF_Calc._DFunction
4048 REM -----------------------------------------------------------------------------
4049 Private Function _FileIdent() As String
4050 ''' Returns a file identification from the information that is currently available
4051 ''' Useful e.g. for display in error messages
4053 _FileIdent = [_Super]._FileIdent()
4055 End Function ' SFDocuments.SF_Calc._FileIdent
4057 REM -----------------------------------------------------------------------------
4058 Function _GetColumnName(ByVal plColumnNumber As Long) As String
4059 ''' Convert a column number (range 1, 2,..16384) into its letter counterpart (range 'A', 'B',..'XFD').
4060 ''' Args:
4062 ''' Returns:
4063 ''' a string representation of the column name, in range 'A'..'XFD'
4064 ''' Adapted from a Python function by sundar nataraj
4065 ''' http://stackoverflow.com/questions/23861680/convert-spreadsheet-number-to-column-letter
4067 Dim sCol As String ' Return value
4068 Dim lDiv As Long ' Intermediate result
4071 Try:
4072 sCol = ""
4073 lDiv = plColumnNumber
4077 lDiv = (lDiv - lMod) \ 26
4078 Loop
4080 Finally:
4081 _GetColumnName = sCol
4082 End Function ' SFDocuments.SF_Calc._GetColumnName
4084 REM -----------------------------------------------------------------------------
4085 Private Function _IsStillAlive(Optional ByVal pbForUpdate As Boolean _
4086 , Optional ByVal pbError As Boolean _
4087 ) As Boolean
4088 ''' Returns True if the document has not been closed manually or incidentally since the last use
4089 ''' If dead the actual instance is disposed. The execution is cancelled when pbError = True (default)
4090 ''' Args:
4091 ''' pbForUpdate: if True (default = False), check additionally if document is open for editing
4092 ''' pbError: if True (default), raise a fatal error
4094 Dim bAlive As Boolean ' Return value
4096 If IsMissing(pbForUpdate) Then pbForUpdate = False
4097 If IsMissing(pbError) Then pbError = True
4099 Try:
4100 bAlive = [_Super]._IsStillAlive(pbForUpdate, pbError)
4102 Finally:
4103 _IsStillAlive = bAlive
4104 Exit Function
4105 End Function ' SFDocuments.SF_Calc._IsStillAlive
4107 REM -----------------------------------------------------------------------------
4108 Private Function _LastCell(ByRef poSheet As Object) As Variant
4109 ''' Returns in an array the coordinates of the last used cell in the given sheet
4111 Dim oCursor As Object ' Cursor on the cell
4112 Dim oRange As Object ' The used range
4115 Try:
4117 oCursor.gotoEndOfUsedArea(True)
4118 Set oRange = poSheet.getCellRangeByName(oCursor.AbsoluteName)
4123 Finally:
4124 _LastCell = vCoordinates
4125 End Function ' SFDocuments.SF_Calc._LastCell
4127 REM -----------------------------------------------------------------------------
4128 Public Function _Offset(ByRef pvRange As Variant _
4129 , ByVal plRows As Long _
4130 , ByVal plColumns As Long _
4131 , ByVal plHeight As Long _
4132 , ByVal plWidth As Long _
4133 ) As Object
4134 ''' Returns a new range offset by a certain number of rows and columns from a given range
4135 ''' Args:
4136 ''' pvRange : the range, as a string or an object, from which the function searches for the new range
4137 ''' plRows : the number of rows by which the reference was corrected up (negative value) or down.
4138 ''' plColumns : the number of columns by which the reference was corrected to the left (negative value) or to the right.
4139 ''' plHeight : the vertical height for an area that starts at the new reference position.
4140 ''' plWidth : the horizontal width for an area that starts at the new reference position.
4141 ''' Arguments Rows and Columns must not lead to zero or negative start row or column.
4142 ''' Arguments Height and Width must not lead to zero or negative count of rows or columns.
4143 ''' Returns:
4144 ''' A new range as object of type _Address
4145 ''' Exceptions:
4146 ''' OFFSETADDRESSERROR The computed range of cells falls beyond the sheet boundaries
4148 Dim oOffset As Object ' Return value
4149 Dim oAddress As Object ' Alias of Range
4150 Dim oSheet As Object ' com.sun.star.sheet.XSpreadsheet
4151 Dim oRange As Object ' com.sun.star.table.XCellRange
4152 Dim oNewRange As Object ' com.sun.star.table.XCellRange
4153 Dim lLeft As Long ' New range coordinates
4154 Dim lTop As Long
4155 Dim lRight As Long
4156 Dim lBottom As Long
4158 Set oOffset = Nothing
4160 Check:
4163 Try:
4164 If VarType(pvRange) = V_STRING Then Set oAddress = _ParseAddress(pvRange) Else Set oAddress = pvRange
4165 Set oSheet = oAddress.XSpreadSheet
4166 Set oRange = oAddress.XCellRange.RangeAddress
4169 ' Compute and validate new coordinates
4170 With oRange
4171 lLeft = .StartColumn + plColumns
4172 lTop = .StartRow + plRows
4178 Then GoTo CatchAddress
4179 Set oNewRange = oSheet.getCellRangeByPosition(lLeft, lTop, lRight, lBottom)
4180 End With
4182 ' Define the new range address
4183 Set oOffset = New _Address
4184 With oOffset
4185 .ObjectType = CALCREFERENCE
4186 .ServiceName = SERVICEREFERENCE
4187 .RawAddress = oNewRange.AbsoluteName
4188 .Component = _Component
4189 .XSpreadsheet = oNewRange.Spreadsheet
4190 .SheetName = .XSpreadsheet.Name
4191 .SheetIndex = .XSpreadsheet.RangeAddress.Sheet
4192 .RangeName = .RawAddress
4193 .XCellRange = oNewRange
4194 .Height = oNewRange.RangeAddress.EndRow - oNewRange.RangeAddress.StartRow + 1
4195 .Width = oNewRange.RangeAddress.EndColumn - oNewRange.RangeAddress.StartColumn + 1
4196 End With
4198 Finally:
4199 Set _Offset = oOffset
4200 Exit Function
4201 Catch:
4202 GoTo Finally
4203 CatchAddress:
4204 ScriptForge.SF_Exception.RaiseFatal(OFFSETADDRESSERROR, "Range", oAddress.RawAddress _
4205 , "Rows", plRows, "Columns", plColumns, "Height", plHeight, "Width", plWidth _
4207 GoTo Finally
4208 End Function ' SFDocuments.SF_Calc._Offset
4210 REM -----------------------------------------------------------------------------
4211 Private Function _ParseAddress(ByVal psAddress As String) As Object
4212 ''' Parse and validate a sheet or range reference
4213 ''' Syntax to parse:
4214 ''' [Sheet].[Range]
4217 ''' Returns:
4218 ''' An object of type _Address
4219 ''' Exceptions:
4222 Dim oAddress As Object ' Return value
4223 Dim sAddress As String ' Alias of psAddress
4224 Dim vRangeName As Variant ' Array Sheet/Range
4225 Dim lStart As Long ' Position of found regex
4226 Dim sSheet As String ' Sheet component
4227 Dim sRange As String ' Range component
4228 Dim oSheets As Object ' com.sun.star.sheet.XSpreadsheets
4229 Dim oNamedRanges As Object ' com.sun.star.sheet.XNamedRanges
4230 Dim oRangeAddress As Object ' Alias for rangeaddress
4231 Dim vLastCell As Variant ' Result of _LastCell() method
4232 Dim oSelect As Object ' Current selection
4234 ' If psAddress has already been parsed, get the result back
4235 If Not IsNull(_LastParsedAddress) Then
4236 ' Given argument must contain an explicit reference to a sheet
4237 If (InStr(psAddress, "~.") = 0 And InStr(psAddress, ".") > 0 And psAddress = _LastParsedAddress.RawAddress) _
4238 Or psAddress = _LastParsedAddress.RangeName Then
4239 Set _ParseAddress = _LastParsedAddress
4240 Exit Function
4241 Else
4242 Set _LastParsedAddress = Nothing
4243 End If
4244 End If
4246 ' Reinitialize a new _Address object
4247 Set oAddress = New _Address
4248 With oAddress
4252 .ObjectType = CALCREFERENCE
4253 .ServiceName = SERVICEREFERENCE
4254 .RawAddress = psAddress
4255 Set .XSpreadSheet = Nothing : Set .XCellRange = Nothing
4258 If Left(psAddress, 2) = "$'" Then sAddress = Mid(psAddress, 2) Else sAddress = psAddress
4259 ' Split in sheet and range components on dot not enclosed in single quotes
4260 vRangeName = ScriptForge.SF_String.SplitNotQuoted(sAddress, Delimiter := ".", QuoteChar := "'")
4261 sSheet = ScriptForge.SF_String.Unquote(Replace(vRangeName(0), "''", "\'"), QuoteChar := "'")
4263 ' Notes:
4264 ' sheet names may contain "$" (even "$" is a valid sheet name), named ranges must not
4265 ' sheet names may contain apostrophes (except in 1st and last positions), range names must not
4266 If Left(vRangeName(0), 2) <> "'$" And Left(sSheet, 1) = "$" And Len(sSheet) > 1 Then sSheet = Mid(sSheet, 2)
4269 ' Resolve sheet part: either a document named range, or the active sheet or a real sheet
4270 Set oSheets = _Component.getSheets()
4271 Set oNamedRanges = _Component.NamedRanges
4272 If oSheets.hasByName(sSheet) Then
4274 sSheet = _Component.CurrentController.ActiveSheet.Name
4275 ElseIf oNamedRanges.hasByName(sSheet) Then
4276 .XCellRange = oNamedRanges.getByName(sSheet).ReferredCells
4277 sSheet = oSheets.getByIndex(oNamedRanges.getByName(sSheet).ReferencePosition.Sheet).Name
4278 Else
4279 sRange = sSheet
4280 sSheet = _Component.CurrentController.ActiveSheet.Name
4281 End If
4282 .SheetName = sSheet
4283 .XSpreadSheet = oSheets.getByName(sSheet)
4284 .SheetIndex = .XSpreadSheet.RangeAddress.Sheet
4286 ' Resolve range part - either a sheet named range or the current selection or a real range or ""
4287 If IsNull(.XCellRange) Then
4288 Set oNamedRanges = .XSpreadSheet.NamedRanges
4290 Set oSelect = _Component.CurrentController.getSelection()
4291 If oSelect.supportsService("com.sun.star.sheet.SheetCellRanges") Then ' Multiple selections
4292 Set .XCellRange = oSelect.getByIndex(0)
4293 Else
4294 Set .XCellRange = oSelect
4295 End If
4297 vLastCell = _LastCell(.XSpreadSheet)
4299 Set .XCellRange = .XSpreadSheet.getCellRangeByName(sRange)
4300 ElseIf oNamedRanges.hasByName(sRange) Then
4301 .XCellRange = oNamedRanges.getByName(sRange).ReferredCells
4302 Else
4303 On Local Error GoTo CatchError
4304 Set .XCellRange = .XSpreadSheet.getCellRangeByName(sRange)
4305 ' If range reaches the limits of the sheets, reduce it up to the used area
4306 Set oRangeAddress = .XCellRange.RangeAddress
4308 vLastCell = _LastCell(.XSpreadSheet)
4311 Set .XCellRange = .XSpreadSheet.getCellRangeByName(sRange)
4313 vLastCell = _LastCell(.XSpreadSheet)
4314 sRange = _GetColumnName(oRangeAddress.StartColumn + 1) & "1" & ":" _
4316 Set .XCellRange = .XSpreadSheet.getCellRangeByName(sRange)
4317 End If
4318 End If
4319 End If
4320 If IsNull(.XCellRange) Then GoTo CatchAddress
4322 Set oRangeAddress = .XCellRange.RangeAddress
4323 .RangeName = .XCellRange.AbsoluteName
4324 .Height = oRangeAddress.EndRow - oRangeAddress.StartRow + 1
4325 .Width = oRangeAddress.EndColumn - oRangeAddress.StartColumn + 1
4327 ' Remember the current component in case of use outside the current instance
4328 Set .Component = _Component
4330 End With
4332 ' Store last parsed address for reuse
4333 Set _LastParsedAddress = oAddress
4335 Finally:
4336 Set _ParseAddress = oAddress
4337 Exit Function
4338 CatchError:
4339 ScriptForge.SF_Exception.Clear()
4340 CatchAddress:
4343 GoTo Finally
4344 End Function ' SFDocuments.SF_Calc._ParseAddress
4346 REM -----------------------------------------------------------------------------
4347 Private Function _PropertyGet(Optional ByVal psProperty As String _
4348 , Optional ByVal pvArg As Variant _
4349 ) As Variant
4350 ''' Return the value of the named property
4351 ''' Args:
4352 ''' psProperty: the name of the property
4354 Dim oProperties As Object ' Document or Custom properties
4355 Dim vLastCell As Variant ' Coordinates of last used cell in a sheet
4356 Dim oSelect As Object ' Current selection
4357 Dim vRanges As Variant ' List of selected ranges
4358 Dim oAddress As Object ' _Address type for range description
4359 Dim oCursor As Object ' com.sun.star.sheet.XSheetCellCursor
4360 Dim i As Long
4361 Dim cstThisSub As String
4362 Const cstSubArgs = ""
4364 _PropertyGet = False
4367 ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs)
4368 If Not _IsStillAlive() Then GoTo Finally
4370 Select Case UCase(psProperty)
4372 Set oSelect = _Component.CurrentController.getSelection()
4373 If IsNull(oSelect) Then
4374 _PropertyGet = Array()
4375 ElseIf oSelect.supportsService("com.sun.star.sheet.SheetCellRanges") Then ' Multiple selections
4376 vRanges = Array()
4378 vRanges = ScriptForge.SF_Array.Append(vRanges, oSelect.getByIndex(i).AbsoluteName)
4379 Next i
4380 _PropertyGet = vRanges
4381 Else
4382 _PropertyGet = oSelect.AbsoluteName
4383 End If
4385 If IsMissing(pvArg) Or IsEmpty(pvArg) Then
4386 _PropertyGet = 0
4387 Else
4389 _PropertyGet = _ParseAddress(pvArg).Height
4390 End If
4391 Case UCase("FirstCell"), UCase("FirstRow"), UCase("FirstColumn") _
4394 If IsMissing(pvArg) Or IsEmpty(pvArg) Then ' Avoid errors when instance is watched in Basic IDE
4395 If InStr(UCase(psProperty), "CELL") > 0 Then _PropertyGet = "" Else _PropertyGet = -1
4396 Else
4398 Set oAddress = _ParseAddress(pvArg)
4399 With oAddress.XCellRange
4400 Select Case UCase(psProperty)
4402 _PropertyGet = A1Style(.RangeAddress.StartRow + 1, .RangeAddress.StartColumn + 1, , , oAddress.XSpreadsheet.Name)
4406 _PropertyGet = A1Style(.RangeAddress.EndRow + 1, .RangeAddress.EndColumn + 1, , , oAddress.XSpreadsheet.Name)
4410 End Select
4411 End With
4412 End If
4414 If IsMissing(pvArg) Or IsEmpty(pvArg) Then
4415 Set _PropertyGet = Nothing
4416 Else
4418 Set _PropertyGet = _ParseAddress(pvArg)
4419 End If
4421 If IsMissing(pvArg) Or IsEmpty(pvArg) Then
4422 _PropertyGet = ""
4423 Else
4425 Set oAddress = _ParseAddress(pvArg)
4426 With oAddress
4427 Set oCursor = .XSpreadsheet.createCursorByRange(.XCellRange)
4428 oCursor.collapseToCurrentRegion()
4429 _PropertyGet = oCursor.AbsoluteName
4430 End With
4431 End If
4433 If IsMissing(pvArg) Or IsEmpty(pvArg) Then
4434 Set _PropertyGet = Nothing
4435 Else
4437 Set _PropertyGet = _ParseAddress(pvArg)
4438 End If
4440 _PropertyGet = _Component.getSheets.getElementNames()
4442 If IsMissing(pvArg) Or IsEmpty(pvArg) Then
4443 _PropertyGet = 0
4444 Else
4446 _PropertyGet = _ParseAddress(pvArg).Width
4447 End If
4449 If IsMissing(pvArg) Or IsEmpty(pvArg) Then
4450 Set _PropertyGet = Nothing
4451 Else
4453 Set _PropertyGet = _ParseAddress(pvArg).XCellRange
4454 End If
4456 If IsMissing(pvArg) Or IsEmpty(pvArg) Then
4457 Set _PropertyGet = Nothing
4458 Else
4460 Set oAddress = _ParseAddress(pvArg)
4461 Set _PropertyGet = oAddress.XSpreadsheet.createCursorByRange(oAddress.XCellRange)
4462 End If
4464 If IsMissing(pvArg) Or IsEmpty(pvArg) Then
4465 Set _PropertyGet = Nothing
4466 Else
4468 Set _PropertyGet = _Component.getSheets.getByName(pvArg)
4469 End If
4470 Case Else
4471 _PropertyGet = Null
4472 End Select
4474 Finally:
4475 ScriptForge.SF_Utils._ExitFunction(cstThisSub)
4476 Exit Function
4477 End Function ' SFDocuments.SF_Calc._PropertyGet
4479 REM -----------------------------------------------------------------------------
4480 Private Function _QuoteSheetName(ByVal psSheetName As String) As String
4481 ''' Return the given sheet name surrounded with single quotes
4482 ''' when required to insert the sheet name into a Calc formula
4483 ''' Enclosed single quotes are doubled
4484 ''' Args:
4485 ''' psSheetName: the name to quote
4486 ''' Returns:
4487 ''' The quoted or unchanged sheet name
4489 Dim sSheetName As String ' Return value
4490 Dim i As Long
4492 Try:
4493 ' Surround the sheet name with single quotes when required by the presence of single quotes
4495 sSheetName = "'" & Replace(psSheetName, "'", "''") & "'"
4496 Else
4497 ' Surround the sheet name with single quotes when required by the presence of at least one of the special characters
4498 sSheetName = psSheetName
4499 For i = 1 To Len(cstSPECIALCHARS)
4502 Exit For
4503 End If
4504 Next i
4505 End If
4507 Finally:
4508 _QuoteSheetName = sSheetName
4509 Exit Function
4510 End Function ' SFDocuments.SF_Calc._QuoteSheetName
4512 REM -----------------------------------------------------------------------------
4513 Private Function _Repr() As String
4514 ''' Convert the SF_Calc instance to a readable string, typically for debugging purposes (DebugPrint ...)
4515 ''' Args:
4516 ''' Return:
4521 End Function ' SFDocuments.SF_Calc._Repr
4523 REM -----------------------------------------------------------------------------
4524 Private Sub _RestoreSelections(ByRef pvComponent As Variant _
4525 , ByRef pvSelection As Variant _
4526 )
4527 ''' Set the selection to a single or a multiple range
4528 ''' Does not work well when multiple selections and macro terminating in Basic IDE
4529 ''' Called by the CopyToCell and CopyToRange methods
4530 ''' Args:
4531 ''' pvComponent: should work for foreign instances as well
4532 ''' pvSelection: the stored selection done previously by Component.CurrentController.getSelection()
4534 Dim oCellRanges As Object ' com.sun.star.sheet.SheetCellRanges
4535 Dim vRangeAddresses As Variant ' Array of com.sun.star.table.CellRangeAddress
4536 Dim i As Long
4538 Try:
4539 If IsArray(pvSelection) Then
4541 vRangeAddresses = Array()
4542 ReDim vRangeAddresses(0 To UBound(pvSelection))
4543 For i = 0 To UBound(pvSelection)
4544 vRangeAddresses(i) = pvSelection.getByIndex(i).RangeAddress
4545 Next i
4546 oCellRanges.addRangeAddresses(vRangeAddresses, False)
4547 pvComponent.CurrentController.select(oCellRanges)
4548 Else
4549 pvComponent.CurrentController.select(pvSelection)
4550 End If
4552 Finally:
4553 Exit Sub
4554 End Sub ' SFDocuments.SF_Calc._RestoreSelections
4556 REM -----------------------------------------------------------------------------
4557 Private Function _ValidateSheet(Optional ByRef pvSheetName As Variant _
4558 , Optional ByVal psArgName As String _
4559 , Optional ByVal pvNew As Variant _
4560 , Optional ByVal pvActive As Variant _
4561 , Optional ByVal pvOptional as Variant _
4562 , Optional ByVal pvNumeric As Variant _
4563 , Optional ByVal pvReference As Variant _
4564 , Optional ByVal pvResetSheet As Variant _
4565 ) As Boolean
4566 ''' Sheet designation validation function similar to the SF_Utils._ValidateXXX functions
4567 ''' Args:
4568 ''' pvSheetName: string or numeric position
4569 ''' pvArgName: the name of the variable to be used in the error message
4570 ''' pvNew: if True, sheet must not exist (default = False)
4572 ''' pvOptional: if True, a zero-length string is accepted (default = False)
4573 ''' pvNumeric: if True, the sheet position is accepted (default = False)
4574 ''' pvReference: if True, a sheet reference is acceptable (default = False)
4575 ''' pvNumeric and pvReference must not both be = True
4576 ''' pvResetSheet: if True, return in pvSheetName the correct (case-sensitive) sheet name (default = False)
4577 ''' Returns
4579 ''' Exceptions
4580 ''' DUPLICATESHEETERROR A sheet with the given name exists already
4582 Dim vSheets As Variant ' List of sheets
4583 Dim lSheet As Long ' Index in list of sheets
4584 Dim vTypes As Variant ' Array of accepted variable types
4585 Dim bValid As Boolean ' Return value
4587 Check:
4588 If IsMissing(pvNew) Or IsEmpty(pvNew) Then pvNew = False
4589 If IsMissing(pvActive) Or IsEmpty(pvActive) Then pvActive = False
4590 If IsMissing(pvOptional) Or IsEmpty(pvOptional) Then pvOptional = False
4591 If IsMissing(pvNumeric) Or IsEmpty(pvNumeric) Then pvNumeric = False
4592 If IsMissing(pvReference) Or IsEmpty(pvReference) Then pvReference = False
4593 If IsMissing(pvResetSheet) Or IsEmpty(pvResetSheet) Then pvResetSheet = False
4595 ' Define the acceptable variable types
4596 If pvNumeric Then
4597 vTypes = Array(V_STRING, V_NUMERIC)
4598 ElseIf pvReference Then
4599 vTypes = Array(V_STRING, ScriptForge.V_OBJECT)
4600 Else
4601 vTypes = V_STRING
4602 End If
4603 If Not ScriptForge.SF_Utils._Validate(pvSheetName, psArgName, vTypes, , , Iif(pvReference, CALCREFERENCE, "")) Then GoTo Finally
4604 bValid = False
4606 Try:
4607 If VarType(pvSheetName) = V_STRING Then
4608 If pvOptional And Len(pvSheetName) = 0 Then
4610 pvSheetName = _Component.CurrentController.ActiveSheet.Name
4611 Else
4612 vSheets = _Component.getSheets.getElementNames()
4613 If pvNew Then
4615 If ScriptForge.SF_Array.Contains(vSheets, pvSheetName) Then GoTo CatchDuplicate
4616 Else
4617 If Not ScriptForge.SF_Utils._Validate(pvSheetName, psArgName, V_STRING, vSheets) Then GoTo Finally
4618 If pvResetSheet Then
4619 lSheet = ScriptForge.SF_Array.IndexOf(vSheets, pvSheetName, CaseSensitive := False)
4620 pvSheetName = vSheets(lSheet)
4621 End If
4622 End If
4623 End If
4624 End If
4625 bValid = True
4627 Finally:
4628 _ValidateSheet = bValid
4629 Exit Function
4630 CatchDuplicate:
4631 ScriptForge.SF_Exception.RaiseFatal(DUPLICATESHEETERROR, psArgName, pvSheetName, "Document", [_Super]._FileIdent())
4632 GoTo Finally
4633 End Function ' SFDocuments.SF_Calc._ValidateSheet
4635 REM -----------------------------------------------------------------------------
4636 Private Function _ValidateSheetName(ByRef psSheetName As String _
4637 , ByVal psArgName As String _
4638 ) As Boolean
4639 ''' Check the validity of the sheet name:
4640 ''' A sheet name - must not be empty
4641 ''' - must not contain next characters: []*?:/\
4643 ''' Args:
4644 ''' psSheetName: the name to check
4645 ''' psArgName: the name of the argument to appear in error messages
4646 ''' Returns:
4647 ''' True when the sheet name is valid
4648 ''' Exceptions:
4651 Dim bValid As Boolean ' Return value
4653 Try:
4655 If bValid Then bValid = ( Left(psSheetName, 1) <> "'" And Right(psSheetName, 1) <> "'" )
4656 If bValid Then bValid = ( Len(ScriptForge.SF_String.FindRegex(psSheetName, "^[^\[\]*?:\/\\]+$", 1, CaseSensitive := False)) > 0 )
4657 If Not bValid Then GoTo CatchSheet
4659 Finally:
4660 _ValidateSheetName = bValid
4661 Exit Function
4662 CatchSheet:
4663 ScriptForge.SF_Exception.RaiseFatal(CALCADDRESSERROR, psArgName, psSheetName _
4665 GoTo Finally
4666 End Function ' SFDocuments.SF_Calc._ValidateSheetName
4668 REM ============================================ END OF SFDOCUMENTS.SF_CALC
4669 </script:module>