wizards/source/scriptforge/SF_Utils.xba | 2
wizards/source/scriptforge/python/scriptforge.py | 6
wizards/source/sfdocuments/SF_Calc.xba | 224 ++++++++++++++++++++++-
3 files changed, 228 insertions(+), 4 deletions(-)
New commits:
commit 43507de5764732300ae9a35cc570b7722a7e1a80
Author: Jean-Pierre Ledure <j...@ledure.be>
AuthorDate: Sun Apr 10 17:05:33 2022 +0200
Commit: Jean-Pierre Ledure <j...@ledure.be>
CommitDate: Sun Apr 10 18:06:05 2022 +0200
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 <j...@ledure.be>
Tested-by: Jenkins
Reviewed-by: Jean-Pierre Ledure <j...@ledure.be>
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"
@@ -651,6 +649,224 @@ Catch:
GoTo Finally
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 _
@@ -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
