diff options
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 |