diff options
| author | Jean-Pierre Ledure <jp@ledure.be> | 2022-04-10 17:05:33 +0200 |
|---|---|---|
| committer | Jean-Pierre Ledure <jp@ledure.be> | 2022-04-10 18:06:05 +0200 |
| commit | 43507de5764732300ae9a35cc570b7722a7e1a80 (patch) | |
| tree | baafc5ae05259e433b7d67c43839f6c2392a1917 /wizards | |
| parent | 64046625553ecbfd9fe0661e5b6f48e283a909e0 (diff) | |
ScriptForge - (SF_Calc) new CompactUp() and CompactLeft() methods
The CompactUp(CompactLeft) method:
Delete the rows(columns) of a specified range matching a filter
expressed as a formula applied on each row(column).
The deleted cells can span whole rows(columns)
or be limited to the width(height) of the range.
The execution of the method has no effect on the
current selection.
Args:
Range: the range in which cells have to be erased, as a string
WholeRow(WholeColumn): when True (default = False),
erase whole rows(columns)
FilterFormula: the formula to be applied on each row(column).
The row(column) is erased when the formula results in True.
The formula shall probably involve one or more cells of
the first row(column) of the range..
By default, a row is erased when all the cells
of the row(column) are empty,
i.e. suppose the range is "A1:J200" (width = 10),
the default value [for CompactUp] becomes "=(COUNTBLANK(A1:J1)=10)"
Returns:
A string representing the location of the initial range
after compaction, or the zero-length string if the whole range
has been deleted.
Examples for CompactUp():
newrange = oDoc.CompactUp("SheetX.G1:L10")
' All empty rows of the range are suppressed
newrange = oDoc.CompactUp("SheetX.G1:L10", WholeRow := True, _
FilterFormula := "=(G1=""X"")")
' The rows having a "X" in column G are completely suppressed
Both methods are available for use from Basic and Python scripts.
Change-Id: Ib1269b22bcd189ca86a1bd3bda2c67e895598cb0
Reviewed-on: https://gerrit.libreoffice.org/c/core/+/132783
Tested-by: Jean-Pierre Ledure <jp@ledure.be>
Tested-by: Jenkins
Reviewed-by: Jean-Pierre Ledure <jp@ledure.be>
Diffstat (limited to 'wizards')
| -rw-r--r-- | wizards/source/scriptforge/SF_Utils.xba | 2 | ||||
| -rw-r--r-- | wizards/source/scriptforge/python/scriptforge.py | 6 | ||||
| -rw-r--r-- | wizards/source/sfdocuments/SF_Calc.xba | 224 |
3 files changed, 228 insertions, 4 deletions
diff --git a/wizards/source/scriptforge/SF_Utils.xba b/wizards/source/scriptforge/SF_Utils.xba index 5dbe667a52f0..e26cca66a776 100644 --- a/wizards/source/scriptforge/SF_Utils.xba +++ b/wizards/source/scriptforge/SF_Utils.xba @@ -1107,4 +1107,4 @@ Finally: End Function ' ScriptForge.SF_Utils._VarTypeObj REM ================================================= END OF SCRIPTFORGE.SF_UTILS -</script:module> +</script:module>
\ No newline at end of file diff --git a/wizards/source/scriptforge/python/scriptforge.py b/wizards/source/scriptforge/python/scriptforge.py index c1261a14fc40..600d8469e623 100644 --- a/wizards/source/scriptforge/python/scriptforge.py +++ b/wizards/source/scriptforge/python/scriptforge.py @@ -2086,6 +2086,12 @@ class SFDocuments: def ClearValues(self, range): return self.ExecMethod(self.vbMethod, 'ClearValues', range) + def CompactLeft(self, range, wholecolumn = False, filterformula = ''): + return self.ExecMethod(self.vbMethod, 'CompactLeft', range, wholecolumn, filterformula) + + def CompactUp(self, range, wholerow = False, filterformula = ''): + return self.ExecMethod(self.vbMethod, 'CompactUp', range, wholerow, filterformula) + def CopySheet(self, sheetname, newname, beforesheet = 32768): sheet = (sheetname.objectreference if isinstance(sheetname, SFDocuments.SF_CalcReference) else sheetname) return self.ExecMethod(self.vbMethod + self.flgObject, 'CopySheet', sheet, newname, beforesheet) diff --git a/wizards/source/sfdocuments/SF_Calc.xba b/wizards/source/sfdocuments/SF_Calc.xba index bc5681992eec..33a523874f39 100644 --- a/wizards/source/sfdocuments/SF_Calc.xba +++ b/wizards/source/sfdocuments/SF_Calc.xba @@ -90,7 +90,6 @@ Private Const RANGEEXPORTERROR = "RANGEEXPORTERROR" REM ============================================================= PRIVATE MEMBERS Private [Me] As Object -Private [_Parent] As Object Private [_Super] As Object ' Document superclass, which the current instance is a subclass of Private ObjectType As String ' Must be CALC Private ServiceName As String @@ -137,7 +136,6 @@ REM ====================================================== CONSTRUCTOR/DESTRUCTO REM ----------------------------------------------------------------------------- Private Sub Class_Initialize() Set [Me] = Nothing - Set [_Parent] = Nothing Set [_Super] = Nothing ObjectType = "CALC" ServiceName = "SFDocuments.Calc" @@ -652,6 +650,224 @@ Catch: End Sub ' SF_Documents.SF_Calc.ClearValues REM ----------------------------------------------------------------------------- +Public Function CompactLeft(Optional ByVal Range As Variant _ + , Optional ByVal WholeColumn As Variant _ + , Optional ByVal FilterFormula As Variant _ + ) As String +''' Delete the columns of a specified range matching a filter expressed as a formula +''' applied on each column. +''' The deleted cells can span whole columns or be limited to the height of the range +''' The execution of the method has no effect on the current selection +''' Args: +''' Range: the range in which cells have to be erased, as a string +''' WholeColumn: when True (default = False), erase whole columns +''' FilterFormula: the formula to be applied on each column. +''' The column is erased when the formula results in True, +''' The formula shall probably involve one or more cells of the first column of the range.. +''' By default, a column is erased when all the cells of the column are empty, +''' i.e. suppose the range is "A1:J200" (height = 0) the default value becomes +''' "=(COUNTBLANK(A1:A200)=200)" +''' Returns: +''' A string representing the location of the initial range after compaction, +''' or the zero-length string if the whole range has been deleted +''' Examples: +''' newrange = oDoc.CompactLeft("SheetX.G1:L10") ' All empty columns of the range are suppressed +''' newrange = oDoc.CompactLeft("SheetX.G1:L10", WholeColumn := True, FilterFormula := "=(G$7=""X"")") +''' ' The columns having a "X" in row 7 are completely suppressed + +Dim sCompact As String ' Return value +Dim oSourceAddress As Object ' Alias of Range as _Address +Dim lLastRow As Long ' Last used row number in the sheet containing Range +Dim sFormulaRange As String ' Range, as a string, where the FilterFormula must be stored +Dim vCompact As Variant ' Array of Boolean values indicating which columns should be erased +Dim lCountDeleted As Long ' Count the deleted columns +Dim lCountToDelete As Long ' Count contiguous columns to be deleted at once +Dim sPartialRange As String ' Contiguous columns to be deleted +Dim i As Long + +Const cstThisSub = "SFDocuments.Calc.CompactLeft" +Const cstSubArgs = "Range, [WholeColumn=False], [FilterFormula=""""]" + + If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch + sCompact = "" + +Check: + If IsMissing(WholeColumn) Or IsEmpty(WholeColumn) Then WholeColumn = False + If IsMissing(FilterFormula) Or IsEmpty(FilterFormula) Then FilterFormula = "" + If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then + If Not _IsStillAlive(True) Then GoTo Finally + If Not ScriptForge.SF_Utils._Validate(Range, "Range", V_STRING) Then GoTo Finally + If Not ScriptForge.SF_Utils._Validate(WholeColumn, "WholeColumn", ScriptForge.V_BOOLEAN) Then GoTo Finally + If Not ScriptForge.SF_Utils._Validate(FilterFormula, "FilterFormula", V_STRING) Then GoTo Finally + End If + +Try: + Set oSourceAddress = _ParseAddress(Range) + + With oSourceAddress + + ' Set the default formula => all cells are blank + If FilterFormula = "" Then FilterFormula = Printf("=(COUNTBLANK(%C1%R1:%C1%R2)-" & .Height & "=0)", Range) + ' Compute the range where to apply the formula + lLastRow = LastRow(.SheetName) + sFormulaRange = Offset(Range, lLastRow - .XCellRange.RangeAddress.StartColumn + 1, , 1) + SetFormula(sFormulaRange, FilterFormula) + ' Get the columns to compact: 0 = False, 1 = True + vCompact = GetValue(sFormulaRange) + ClearAll(sFormulaRange) + + ' Iterates from the last to the first column of the range and remove the columns that match the filter + ' by groups of contiguous columns + lCountDeleted = 0 + lCountToDelete = 0 + For i = UBound(vCompact) To 0 Step -1 + If vCompact(i) = 1 Then lCountToDelete = lCountToDelete + 1 + If i > 0 And vCompact(i) = 1 Then + ' Do nothing + ElseIf lCountToDelete > 0 Then ' The current column must be kept but columns at the left must be removed + ' Do not forget when the 1st column must be removed + sPartialRange = Offset(Range, , Iif(i = 0 And vCompact(i) = 1, 0, i + 1), , lCountToDelete) + ShiftLeft(sPartialRange, WholeColumn) + lCountDeleted = lCountDeleted + lCountToDelete + lCountToDelete = 0 + End If + Next i + + ' Compute the final range position + If lCountDeleted < .Width Then sCompact = Offset(Range, 0, 0, , .Width - lCountDeleted) + + ' Push rightwards the cells that migrated leftwards irrelevantly + If Not WholeColumn Then + If Len(sCompact) > 0 Then + sPartialRange = Offset(sCompact, 0, .Width - lCountDeleted, , lCountDeleted) + Else + sPartialRange = .RangeName + End If + ShiftRight(sPartialRange, WholeColumn := False) + End If + + End With + +Finally: + CompactLeft = sCompact + ScriptForge.SF_Utils._ExitFunction(cstThisSub) + Exit Function +Catch: + ' When error, return the original range + If Not IsNull(oSourceAddress) Then sCompact = oSourceAddress.RangeName + GoTo Finally +End Function ' SFDocuments.SF_Calc.CompactLeft + +REM ----------------------------------------------------------------------------- +Public Function CompactUp(Optional ByVal Range As Variant _ + , Optional ByVal WholeRow As Variant _ + , Optional ByVal FilterFormula As Variant _ + ) As String +''' Delete the rows of a specified range matching a filter expressed as a formula +''' applied on each row. +''' The deleted cells can span whole rows or be limited to the width of the range +''' The execution of the method has no effect on the current selection +''' Args: +''' Range: the range in which cells have to be erased, as a string +''' WholeRow: when True (default = False), erase whole rows +''' FilterFormula: the formula to be applied on each row. +''' The row is erased when the formula results in True, +''' The formula shall probably involve one or more cells of the first row of the range.. +''' By default, a row is erased when all the cells of the row are empty, +''' i.e. suppose the range is "A1:J200" (width = 10) the default value becomes +''' "=(COUNTBLANK(A1:J1)=10)" +''' Returns: +''' A string representing the location of the initial range after compaction, +''' or the zero-length string if the whole range has been deleted +''' Examples: +''' newrange = oDoc.CompactUp("SheetX.G1:L10") ' All empty rows of the range are suppressed +''' newrange = oDoc.CompactUp("SheetX.G1:L10", WholeRow := True, FilterFormula := "=(G1=""X"")") +''' ' The rows having a "X" in column G are completely suppressed + +Dim sCompact As String ' Return value +Dim oSourceAddress As Object ' Alias of Range as _Address +Dim lLastCol As Long ' Last used column number in the sheet containing Range +Dim sFormulaRange As String ' Range, as a string, where the FilterFormula must be stored +Dim vCompact As Variant ' Array of Boolean values indicating which rows should be erased +Dim lCountDeleted As Long ' Count the deleted rows +Dim lCountToDelete As Long ' Count contiguous rows to be deleted at once +Dim sPartialRange As String ' Contiguous rows to be deleted +Dim i As Long + +Const cstThisSub = "SFDocuments.Calc.CompactUp" +Const cstSubArgs = "Range, [WholeRow=False], [FilterFormula=""""]" + + If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch + sCompact = "" + +Check: + If IsMissing(WholeRow) Or IsEmpty(WholeRow) Then WholeRow = False + If IsMissing(FilterFormula) Or IsEmpty(FilterFormula) Then FilterFormula = "" + If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then + If Not _IsStillAlive(True) Then GoTo Finally + If Not ScriptForge.SF_Utils._Validate(Range, "Range", V_STRING) Then GoTo Finally + If Not ScriptForge.SF_Utils._Validate(WholeRow, "WholeRow", ScriptForge.V_BOOLEAN) Then GoTo Finally + If Not ScriptForge.SF_Utils._Validate(FilterFormula, "FilterFormula", V_STRING) Then GoTo Finally + End If + +Try: + Set oSourceAddress = _ParseAddress(Range) + + With oSourceAddress + + ' Set the default formula => all cells are blank + If FilterFormula = "" Then FilterFormula = Printf("=(COUNTBLANK(%C1%R1:%C2%R1)-" & .Width & "=0)", Range) + ' Compute the range where to apply the formula + lLastCol = LastColumn(.SheetName) + sFormulaRange = Offset(Range, , lLastCol - .XCellRange.RangeAddress.StartRow + 1, , 1) + SetFormula(sFormulaRange, FilterFormula) + ' Get the rows to compact: 0 = False, 1 = True + vCompact = GetValue(sFormulaRange) + ClearAll(sFormulaRange) + + ' Iterates from the last to the first row of the range and remove the rows that match the filter + ' by groups of contiguous rows + lCountDeleted = 0 + lCountToDelete = 0 + For i = UBound(vCompact) To 0 Step -1 + If vCompact(i) = 1 Then lCountToDelete = lCountToDelete + 1 + If i > 0 And vCompact(i) = 1 Then + ' Do nothing + ElseIf lCountToDelete > 0 Then ' The current row must be kept but rows below must be removed + ' Do not forget when the 1st row must be removed + sPartialRange = Offset(Range, Iif(i = 0 And vCompact(i) = 1, 0, i + 1), , lCountToDelete) + ShiftUp(sPartialRange, WholeRow) + lCountDeleted = lCountDeleted + lCountToDelete + lCountToDelete = 0 + End If + Next i + + ' Compute the final range position + If lCountDeleted < .Height Then sCompact = Offset(Range, 0, 0, .Height - lCountDeleted) + + ' Push downwards the cells that migrated upwards irrelevantly + If Not WholeRow Then + If Len(sCompact) > 0 Then + sPartialRange = Offset(sCompact, .Height - lCountDeleted, 0, lCountDeleted) + Else + sPartialRange = .RangeName + End If + ShiftDown(sPartialRange, WholeRow := False) + End If + + End With + +Finally: + CompactUp = sCompact + ScriptForge.SF_Utils._ExitFunction(cstThisSub) + Exit Function +Catch: + ' When error, return the original range + If Not IsNull(oSourceAddress) Then sCompact = oSourceAddress.RangeName + GoTo Finally +End Function ' SFDocuments.SF_Calc.CompactUp + +REM ----------------------------------------------------------------------------- Public Function CopySheet(Optional ByVal SheetName As Variant _ , Optional ByVal NewName As Variant _ , Optional ByVal BeforeSheet As Variant _ @@ -1925,7 +2141,7 @@ Public Function Offset(Optional ByRef Range As Variant _ ''' Exceptions: ''' OFFSETADDRESSERROR The computed range of cells falls beyond the sheet boundaries ''' Examples: -''' oDoc.Offset("A1", 2, 2) ' "'SheetX'.$C$3" (A1 moved by two rows and two columns down) +''' oDoc.Offset("A1", 2, 2) ' "'SheetX'.$C$3" (A1 moved by two rows and two columns down) ''' oDoc.Offset("A1", 2, 2, 5, 6) ' "'SheetX'.$C$3:$H$7" Dim sOffset As String ' Return value @@ -2727,6 +2943,7 @@ Check: Try: Set oSourceAddress = _ParseAddress(Range) + Set _LastParsedAddress = Nothing ' Range will be erased. Force re-parsing next time With oSourceAddress @@ -2889,6 +3106,7 @@ Check: Try: Set oSourceAddress = _ParseAddress(Range) + Set _LastParsedAddress = Nothing ' Range will be erased. Force re-parsing next time With oSourceAddress |