diff options
Diffstat (limited to 'wizards/source/sfdocuments/SF_Calc.xba')
| -rw-r--r-- | wizards/source/sfdocuments/SF_Calc.xba | 77 |
1 files changed, 74 insertions, 3 deletions
diff --git a/wizards/source/sfdocuments/SF_Calc.xba b/wizards/source/sfdocuments/SF_Calc.xba index 8b3b7101ed40..7bd5e4e8d251 100644 --- a/wizards/source/sfdocuments/SF_Calc.xba +++ b/wizards/source/sfdocuments/SF_Calc.xba @@ -372,7 +372,7 @@ Const cstSubArgs = "Row1, Column1, [Row2], [Column2], [SheetName]="&qu Check: If IsMissing(Row2) Or IsEmpty(Row2) Then Row2 = 0 If IsMissing(Column2) Or IsEmpty(Column2) Then Column2 = 0 - If IsMissing(SheetName) Or IsEmpty(SheetName) Then SheetName = "~" + If IsMissing(SheetName) Or IsEmpty(SheetName) Then SheetName = "" vSheetName = SheetName If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then @@ -388,6 +388,11 @@ Check: If Row2 > MAXROWS Then Row2 = MAXROWS If Column1 > MAXCOLS Then Column1 = MAXCOLS If Column2 > MAXCOLS Then Column2 = MAXCOLS + If Row1 <= 0 Or Column1 <= 0 Then GoTo Catch + If Row2 = Row1 And Column2 = Column1 Then ' Single cell + Row2 = 0 + Column2 = 0 + End If If Row2 > 0 And Row2 < Row1 Then lTemp = Row2 : Row2 = Row1 : Row1 = lTemp @@ -398,9 +403,9 @@ Check: Try: ' Surround the sheet name with single quotes when required by the presence of special characters - vSheetName = _QuoteSheetName(vSheetName) + If Len(vSheetName) > 0 Then vSheetName = "$" & _QuoteSheetName(vSheetName) & "." ' Define the new range string - sA1Style = "$" & vSheetName & "." _ + sA1Style = vSheetName _ & "$" & _GetColumnName(Column1) & "$" & CLng(Row1) _ & Iif(Row2 > 0 And Column2 > 0, ":$" & _GetColumnName(Column2) & "$" & CLng(Row2), "") @@ -2088,6 +2093,71 @@ Catch: End Function ' SFDocuments.SF_Calc.InsertSheet REM ----------------------------------------------------------------------------- +Public Function Intersect(Optional ByVal Range1 As Variant _ + , Optional ByVal Range2 As Variant _ + ) As String +''' Returns the cell range as a string that is common to the input ranges +''' Args: +''' Range1: a first range as a string +''' Range2: a second range as a string +''' Returns: +''' The intersection, as a string, representing the range common to both input ranges, +''' or a zero-length string when the intersection is empty. +''' Example: +''' calc.Intersect("J7:M11", "$Sheet2.$L$10:$N$17") +''' ' $Sheet2.$L$10:$M$11 when Sheet2 is the current sheet, otherwise the empty string + +Dim sIntersect As String ' Return value +Dim oRangeAddress1 As Object ' SF_UI._Address type +Dim oRangeAddress2 As Object ' SF_UI._Address type +Dim oRange1 As Object ' com.sun.star.table.CellRangeAddress +Dim oRange2 As Object ' com.sun.star.table.CellRangeAddress +Dim lStartRow As Long ' Intersection starting row +Dim lEndRow As Long ' Intersection ending row +Dim lStartColumn As Long ' Intersection starting column +Dim lEndColumn As Long ' Intersection ending column + +Const cstThisSub = "SFDocuments.Calc.Intersect" +Const cstSubArgs = "Range1, Range2" + + If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch + sIntersect = "" + +Check: + If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then + If Not _IsStillAlive(True) Then GoTo Finally + If Not ScriptForge.SF_Utils._Validate(Range1, "Range1", V_STRING) Then GoTo Finally + If Not ScriptForge.SF_Utils._Validate(Range2, "Range2", V_STRING) Then GoTo Finally + End If + + Set oRangeAddress1 = _ParseAddress(Range1) + Set oRange1 = oRangeAddress1.XCellRange.RangeAddress + Set oRangeAddress2 = _ParseAddress(Range2) + Set oRange2 = oRangeAddress2.XCellRange.RangeAddress + + If oRangeAddress1.SheetName <> oRangeAddress2.SheetName Then GoTo Finally + +Try: + ' Find the top-left and bottom-right coordinates of the intersection + lStartRow = Iif(oRange1.StartRow > oRange2.StartRow, oRange1.StartRow, oRange2.StartRow) + 1 + lStartColumn = Iif(oRange1.StartColumn > oRange2.StartColumn, oRange1.StartColumn, oRange2.StartColumn) + 1 + lEndRow = Iif(oRange1.EndRow < oRange2.EndRow, oRange1.EndRow, oRange2.EndRow) + 1 + lEndColumn = Iif(oRange1.EndColumn < oRange2.EndColumn, oRange1.EndColumn, oRange2.EndColumn) + 1 + + ' Check that the 2 ranges overlap each other + If lStartRow <= lEndRow And lStartColumn <= lEndColumn Then + sIntersect = A1Style(lStartRow, lStartColumn, lEndRow, lEndColumn, oRangeAddress1.SheetName) + End If + +Finally: + Intersect = sIntersect + 'ScriptForge.SF_Utils._ExitFunction(cstThisSub) + Exit Function +Catch: + GoTo Finally +End Function ' SFDocuments.SF_Calc.Intersect + +REM ----------------------------------------------------------------------------- Public Function Methods() As Variant ''' Return the list of public methods of the Calc service as an array @@ -2114,6 +2184,7 @@ Public Function Methods() As Variant , "ImportFromCSVFile" _ , "ImportFromDatabase" _ , "InsertSheet" _ + , "Intersect" _ , "MoveRange" _ , "MoveSheet" _ , "Offset" _ |