diff options
| -rw-r--r-- | wizards/source/scriptforge/SF_Array.xba | 372 | ||||
| -rw-r--r-- | wizards/source/scriptforge/SF_Exception.xba | 2 | ||||
| -rw-r--r-- | wizards/source/sfdocuments/SF_Calc.xba | 210 |
3 files changed, 380 insertions, 204 deletions
diff --git a/wizards/source/scriptforge/SF_Array.xba b/wizards/source/scriptforge/SF_Array.xba index 557d40226754..53b72b72b225 100644 --- a/wizards/source/scriptforge/SF_Array.xba +++ b/wizards/source/scriptforge/SF_Array.xba @@ -335,6 +335,235 @@ Catch: End Function ' ScriptForge.SF_Array.Contains REM ----------------------------------------------------------------------------- +Public Function ConvertFromDataArray(Optional ByRef DataArray As Variant _ + , Optional ByVal IsRange As Variant _ + , Optional ByVal FillValue As Variant _ + ) As Variant +''' Convert a data array to a scalar, a vector or a 2D array +''' A "data array" is an array of subarrays. The array and the subarrays must be zero-based. +''' The individual items may be of any type. +''' On request, the individual items are reduced to strings or doubles only. +''' Typically it represents +''' - the content of a range of Calc cells returned by the UNO XCellRange.getDataArray() +''' or XCellRange.getFormulaArray() methods +''' - the output of the SF_Session.ExecuteCalcFunction() method +''' - a tuple of (sub)tuples returned by a Python script. +''' Args: +''' DataArray: an array of subarrays. Array and subarrays must be zero-based. +''' IsRange: When True (default = False), the items are converted to strings or doubles. +''' FillValue: Default value of missing items. Default = the empty string +''' Returns: +''' A scalar, a zero-based 1D array or a zero-based 2D array. +''' The number of columns in the resulting 2D array = the number of items in the 1st subarray. +''' If next subarrays have a different size, next rows can be complemented with FillValue or truncated. +''' Example: +''' vDataArray = Array(Array("Col1", "Col2", "Col3"), Array(10, 20, 30)) +''' Array2D = SF_Array.ConvertFromDataArray(vDataArray) +''' MsgBox Array2D(1, 2) ' 30 + +Dim vArray As Variant ' Return value +Dim lMax1 As Long ' UBound of DataArray +Dim lMax2 As Long ' UBound of the 1st row of DataArray +Dim lMax As Long ' UBound of a subarray +Dim i As Long +Dim j As Long + +Const cstThisSub = "Array.ConvertFromDataArray" +Const cstSubArgs = "DataArray, [IsRange=False], [FillValue=""""]" + + If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch + vArray = Array() + +Check: + If IsMissing(IsRange) Or IsEmpty(IsRange) Then IsRange = False + If IsMissing(FillValue) Or IsEmpty(FillValue) Then FillValue = "" + If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then + If Not SF_Utils._ValidateArray(DataArray, "DataArray", 1) Then GoTo Finally + For i = 0 To UBound(DataArray) + If Not SF_Utils._ValidateArray(DataArray(i), "DataArray(" & i & ")", 1) Then GoTo Finally + Next i + End If + +Try: + ' Convert the data array to scalar, vector or array + lMax1 = UBound(DataArray) + If lMax1 >= 0 Then + lMax2 = UBound(DataArray(0)) + If lMax2 >= 0 Then + If lMax1 + lMax2 > 0 Then vArray = Array() + Select Case True + Case lMax1 = 0 And lMax2 = 0 ' Scalar + vArray = _ConvertToCellValue(DataArray(0)(0), pbIsCell := IsRange) + Case lMax1 > 0 And lMax2 = 0 ' Vertical vector + ReDim vArray(0 To lMax1) + For i = 0 To lMax1 + vArray(i) = _ConvertToCellValue(DataArray(i)(0), pbIsCell := IsRange) + Next i + Case lMax1 = 0 And lMax2 > 0 ' Horizontal vector + ReDim vArray(0 To lMax2) + For j = 0 To lMax2 + vArray(j) = _ConvertToCellValue(DataArray(0)(j), pbIsCell := IsRange) + Next j + Case Else ' Array + ReDim vArray(0 To lMax1, 0 To lMax2) + For i = 0 To lMax1 + lMax = UBound(DataArray(i)) + For j = 0 To lMax2 + If j <= lMax Then vArray(i, j) = _ConvertToCellValue(DataArray(i)(j), pbIsCell := IsRange) Else vArray(i, j) = FillValue + Next j + Next i + End Select + End If + End If + +Finally: + ConvertFromDataArray = vArray + SF_Utils._ExitFunction(cstThisSub) + Exit Function +Catch: + GoTo Finally +End Function ' ScriptForge.SF_Array.ConvertFromDataArray + +REM ----------------------------------------------------------------------------- +Public Function ConvertToDataArray(Optional ByRef Data As Variant _ + , Optional ByVal IsRange As Variant _ + , Optional ByVal Rows As Variant _ + , Optional ByVal Columns As Variant _ + ) As Variant +''' Create a data array from a scalar, a 1D array or a 2D array +''' The returned "data array" is an array of subarrays. +''' On request, the individual items are reduced to strings or doubles only. +''' Typically it represents +''' - the content of a range of Calc cells used to apply the UNO XCellRange.setDataArray() +''' or XCellRange.setFormulaArray() methods +''' - a tuple of (sub)tuples passed to a Python script. +''' Input argument may already be a data array, typically when call is issued by a Python script. +''' When IsRange = True then the individual items are converted to (possibly empty) strings or doubles. +''' Args: +''' Data: the input scalar or array. If array, must be 1D or 2D otherwise it is ignored. +''' IsRange: When True (default = False), the items are converted to strings or doubles. +''' Rows, Columns: the number of rows or columns of the returned data array. +''' If bigger than Data, fill with zero-length strings +''' If smaller than Data, truncate +''' If Rows = 1 and the input array is a vector, the data array is aligned horizontally +''' By defauly, vectors are aligned vertically. +''' When absent, the size of the output is determined by the input array. +''' Returns: +''' The output is always an array of nested arrays. Array and nested arrays are zero-based. +''' It is compatible with the XCellRange.DataArray property when IsRange = True. + +Dim vDataArray() As Variant ' Return value +Dim vVector() As Variant ' A temporary 1D array +Dim vItem As Variant ' A single input item +Dim iDims As Integer ' Number of dimensions of the input argument +Dim lMin1 As Long ' Lower bound (1) of input array +Dim lMax1 As Long ' Upper bound (1) +Dim lMin2 As Long ' Lower bound (2) +Dim lMax2 As Long ' Upper bound (2) +Dim lRows As Long ' Upper bound of vDataArray +Dim lCols As Long ' Upper bound of vVector +Dim bHorizontal As Boolean ' Horizontal vectoriDims <> 0 => Data has at least 1 item +Dim bDataArray As Boolean ' Input array is already an array of arrays +Dim i As Long +Dim j As Long +Const cstEmpty = "" ' Empty cell + +Const cstThisSub = "Array.ConvertToDataArray" +Const cstSubArgs = "Data, [IsRange=False], [Rows=0], [Columns=0]" + + If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch + vDataArray = Array() + +Check: + If IsMissing(IsRange) Or IsEmpty(IsRange) Then IsRange = False + If IsMissing(Rows) Or IsEmpty(Rows) Then Rows = 0 + If IsMissing(Columns) Or IsEmpty(Columns) Then Columns = 0 + If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then + If Not SF_Utils._Validate(IsRange, "IsRange", V_BOOLEAN) Then GoTo Finally + If Not SF_Utils._Validate(Rows, "Rows", V_NUMERIC) Then GoTo Finally + If Not SF_Utils._Validate(Columns, "Columns", V_NUMERIC) Then GoTo Finally + End If + +Try: + ' Examine the input argument and determine its boundaries + ' Set the output dimensions accordingly + iDims = SF_Array.CountDims(Data) + If iDims = 0 Or iDims > 2 Then Exit Function + lMin1 = 0 : lMax1 = 0 ' Default values + lMin2 = 0 : lMax2 = 0 + lRows = 0 : lCols = 0 + Select Case iDims + Case -1 ' Scalar value + Case 1 ' 1D Array + bHorizontal = ( Rows = 1 ) + bDataArray = IsArray(Data(LBound(Data))) + If Not bDataArray Then + If Not bHorizontal Then + lMin1 = LBound(Data) : lMax1 = UBound(Data) + lRows = lMax1 - lMin1 + Else + lMin2 = LBound(Data) : lMax2 = UBound(Data) + lCols = lMax2 - lMin2 + End If + Else + iDims = 2 + lMin1 = LBound(Data) : lMax1 = UBound(Data) + lMin2 = LBound(Data(0)) : lMax2 = UBound(Data(0)) + lRows = lMax1 - lMin1 + lCols = lMax2 - lMin2 + End If + Case 2 ' 2D Array + lMin1 = LBound(Data, 1) : lMax1 = UBound(Data, 1) + lMin2 = LBound(Data, 2) : lMax2 = UBound(Data, 2) + lRows = lMax1 - lMin1 + lCols = lMax2 - lMin2 + End Select + + ' Size the future data array to the output dimensions + ' Are the dimensions imposed ? + If Rows >= 1 Then lRows = Rows - 1 + If Columns >= 1 Then lCols = Columns - 1 + ReDim vDataArray(0 To lRows) + + ' Feed the output array row by row, each row being a vector + For i = 0 To lRows + ReDim vVector(0 To lCols) + For j = 0 To lCols + If i > lMax1 - lMin1 Then + vVector(j) = cstEmpty + ElseIf j > lMax2 - lMin2 Then + vVector(j) = cstEmpty + Else + Select Case iDims + Case -1 : vItem = _ConvertToCellValue(Data, IsRange) + Case 1 + If bHorizontal Then + vItem = _ConvertToCellValue(Data(j + lMin2), IsRange) + Else + vItem = _ConvertToCellValue(Data(i + lMin1), IsRange) + End If + Case 2 + If bDataArray Then + vItem = _ConvertToCellValue(Data(i + lMin1)(j + lMin2), IsRange) + Else + vItem = _ConvertToCellValue(Data(i + lMin1, j + lMin2), IsRange) + End If + End Select + vVector(j) = vItem + End If + vDataArray(i) = vVector + Next j + Next i + +Finally: + ConvertToDataArray = vDataArray + SF_Utils._ExitFunction(cstThisSub) + Exit Function +Catch: + GoTo Finally +End Function ' ScriptForge.SF_Array.ConvertToDataArray + +REM ----------------------------------------------------------------------------- Public Function ConvertToDictionary(Optional ByRef Array_2D As Variant) As Variant ''' Store the content of a 2-columns array into a dictionary with case-sensitive comparison of keys ''' Key found in 1st column, Item found in 2nd @@ -374,6 +603,120 @@ Catch: End Function ' ScriptForge.SF_Array.ConvertToDictionary REM ----------------------------------------------------------------------------- +Public Function ConvertToRange(Optional ByRef Data As Variant _ + , Optional ByVal Direction As Variant _ + ) As Variant +''' Create a valid cells range content from a scalar, a 1D array, a 2D array or a data array +''' (a "data array" is an array of subarrays). Lower bounds are preserved. +''' The individual items are always reduced to strings or doubles. Including booleans or dates. +''' The returned scalar or array is a valid argument of the SF_Session.ExecuteCalcFunction() method. +''' Input argument may be a data array, typically when returned by a Python script. +''' Args: +''' Data: the input scalar, array or data array. If array, must be 1D or 2D, otherwise 0 is returned. +''' Direction: the alignment of the range when it is a vector, either "V"[ertical, default] or "H"[orizontal]. +''' Returns: +''' A scalar or a 2D array compatible with the format of the arguments expected by +''' - the SF_Session.ExecuteCalcFunction() method, in the context of [complex] array functions +''' - a Calc user-defined function when called by a macro +''' Example: +''' arr = CreateScriptService("Array") +''' sess = CreateScriptService("Session") +''' matrix = Array(Array(-1, 2, 3), Array(4, -5, 6), Array(7, 8, -9)) ' Input = a data array +''' result = sess.ExecuteCalcFunction("ABS", arr.ConvertToRange(matrix)) +''' ' result is a data array; result(2)(2) = 9 + +Dim vRange As Variant ' Return value +Dim iDims As Integer ' Number of dimensions of Data +Dim vDataArray As Variant ' External array of a data array +Dim vVector As Variant ' Internal array of a data array +Dim lMin1 As Long ' Lower bound #1 +Dim lMax1 As Long ' Upper bound #1 +Dim lMin2 As Long ' Lower bound #2 +Dim lMax2 As Long ' Upper bound #2 +Dim lMin As Long ' Lower bound +Dim lMax As Long ' Upper bound +Dim i As Long +Dim j As Long + +Const cstThisSub = "Array.ConvertToRange" +Const cstSubArgs = "Data, [Direction=""""|""V""|""H""]" + + If SF_Utils._ErrorHandling() Then On Local Error GoTo Catch + vRange = 0 + +Check: + If IsMissing(Direction) Or IsEmpty(Direction) Then Direction = "V" + If SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then + If IsMissing(Data) Or IsEmpty(Data) Then + If Not SF_Utils._Validate(Data, "Data") Then GoTo Finally + End If + If Not SF_Utils._Validate(Direction, "Direction", V_STRING, Array("", "V", "H")) Then GoTo Finally + End If + +Try: + iDims = SF_Array.CountDims(Data) + If iDims = 0 Or iDims > 2 Then Exit Function + + Select Case iDims + ' All input items are converted on-the-fly to an acceptable Calc cell value + Case -1 ' Scalar + vRange = _ConvertToCellValue(Data, pbIsCell := True) + Case 1 ' Vector or data array + ' iDims <> 0 => Data has at least 1 item + lMin1 = LBound(Data) : lMax1 = UBound(Data) + If IsArray(Data(lMin1)) Then ' Data array + ' Design a 2D array of the appropriate size + lMin2 = LBound(Data(lMin1)) : lMax2 = UBound(Data(lMin1)) + vRange = Array() + ReDim vRange(lMin1 To lMax1, lMin2 To lMax2) + For i = lMin1 To lMax1 + If Not IsArray(Data(i)) Then + lMin = -1 : lMax = -1 + Else + lMin = LBound(Data(i)) + lMax = UBound(Data(i)) + End If + For j = lMin2 To lMax2 + If j < lMin Or j > lMax Then vRange(i, j) = "" Else vRange(i, j) = _ConvertToCellValue(Data(i)(j), pbIsCell := True) + Next j + Next i + Else ' Vector + vRange = Array() + If UCase(Direction) = "V" Then ' Vertical + ReDim vRange(lMin1 To lMax1, 0 To 0) + For i = lMin1 To lMax1 + vRange(i, 0) = _ConvertToCellValue(Data(i), pbIsCell := True) + Next i + Else ' Horizontal + ReDim vRange(0 To 0, lMin1 To lMax1) + For j = lMin1 To lMax1 + vRange(0, j) = _ConvertToCellValue(Data(j), pbIsCell := True) + Next j + End If + End If + Case 2 + ' Copy all array items + vRange = Array() + lMin1 = LBound(Data, 1) : lMax1 = UBound(Data, 1) + lMin2 = LBound(Data, 2) : lMax2 = UBound(Data, 2) + ReDim vRange(lMin1 To lMax1, lMin2 To lMax2) + For i = lMin1 To lMax1 + For j = lMin2 To lMax2 + vRange(i, j) = _ConvertToCellValue(Data(i, j), pbIsCell := True) + Next j + Next i + Case Else + End Select + +Finally: + ConvertToRange = vRange + SF_Utils._ExitFunction(cstThisSub) + Exit Function +Catch: + GoTo Finally +End Function ' ScriptForge.SF_Array.ConvertToRange + +REM ----------------------------------------------------------------------------- Public Function Copy(Optional ByRef Array_ND As Variant) As Variant ''' Duplicate a 1D or 2D array ''' A usual assignment copies an array by reference, i.e. shares the same memory location @@ -2326,6 +2669,35 @@ End Function ' ScriptForge.SF_Array.Unique REM ============================================================= PRIVATE METHODS REM ----------------------------------------------------------------------------- +Private Function _ConvertToCellValue(ByVal pvItem As Variant _ + , ByVal pbIsCell As Boolean _ + ) As Variant +''' Convert the argument to a valid Calc cell content, i.e. a string or a double. +''' When the argument is not convertible, either +''' - the zero-length string is returned (pbIsCell = True) +''' - the argument is returned unchanged (pbIsCell = False) + +Dim vCell As Variant ' Return value + +Try: + If pbIsCell Then + Select Case SF_Utils._VarTypeExt(pvItem) + Case V_STRING : vCell = pvItem + Case V_DATE : vCell = CDbl(pvItem) + Case V_NUMERIC : vCell = CDbl(pvItem) + Case V_BOOLEAN : vCell = CDbl(Iif(pvItem, 1, 0)) + Case Else : vCell = "" + End Select + Else ' Return the input item unchanged + vCell = pvItem + End If + +Finally: + _ConvertToCellValue = vCell + Exit Function +End Function ' ScriptForge.SF_Array._ConvertToCellValue + +REM ----------------------------------------------------------------------------- Public Function _FindItem(ByRef pvArray_1D As Variant _ , ByVal pvToFind As Variant _ , ByVal pbCaseSensitive As Boolean _ diff --git a/wizards/source/scriptforge/SF_Exception.xba b/wizards/source/scriptforge/SF_Exception.xba index 9e27c5202124..ad0566ddfe9f 100644 --- a/wizards/source/scriptforge/SF_Exception.xba +++ b/wizards/source/scriptforge/SF_Exception.xba @@ -791,7 +791,7 @@ Try: ' Location header common to all error messages If Len(_SF_.MainFunction) > 0 Then ' MainFunction = [Library.]Module.Method vLocation = Split(_SF_.MainFunction, ".") - If UBound(vLocation) < 2 Then vLocation = Split("ScriptForge." & _SF_.MainFunction, ".") + If UBound(vLocation) < 2 Then vLocation = Split("ScriptForge." & _SF_.MainFunction, ".") sService = vLocation(1) sMethod = vLocation(2) sLocation = L10N.GetText("VALIDATESOURCE", vLocation(0), sService, sMethod) _ diff --git a/wizards/source/sfdocuments/SF_Calc.xba b/wizards/source/sfdocuments/SF_Calc.xba index f7d1eebae18c..b644f66c8120 100644 --- a/wizards/source/sfdocuments/SF_Calc.xba +++ b/wizards/source/sfdocuments/SF_Calc.xba @@ -1748,7 +1748,7 @@ Try: vDataArray = oAddress.XCellRange.getFormulaArray() ' Convert the data array to scalar, vector or array - vGet = _ConvertFromDataArray(vDataArray) + vGet = ScriptForge.SF_Array.ConvertFromDataArray(vDataArray) Finally: GetFormula = vGet @@ -1833,7 +1833,7 @@ Try: vDataArray = oAddress.XCellRange.getDataArray() ' Convert the data array to scalar, vector or array - vGet = _ConvertFromDataArray(vDataArray) + vGet = ScriptForge.SF_Array.ConvertFromDataArray(vDataArray) Finally: GetValue = vGet @@ -2830,7 +2830,7 @@ Check: Try: ' Convert argument to data array and derive new range from its size - vDataArray = _ConvertToDataArray(Value) + vDataArray = ScriptForge.SF_Array.ConvertToDataArray(Value, IsRange := True) If UBound(vDataArray) < LBound(vDataArray) Then GoTo Finally Set oSet = _Offset(TargetCell, 0, 0, plHeight := UBound(vDataArray) + 1, plWidth := UBound(vDataArray(0)) + 1) ' +1 : vDataArray is zero-based With oSet @@ -2971,7 +2971,7 @@ Try: With oAddress If IsArray(Formula) Then ' Convert to data array and limit its size to the size of the initial range - vDataArray = _ConvertToDataArray(Formula, .Height - 1, .Width - 1) + vDataArray = ScriptForge.SF_Array.ConvertToDataArray(Formula, Rows := .Height, Columns := .Width) If UBound(vDataArray) < LBound(vDataArray) Then GoTo Finally .XCellRange.setFormulaArray(vDataArray) Else @@ -3054,7 +3054,7 @@ Public Function SetValue(Optional ByVal TargetRange As Variant _ ''' Vectors are always expanded vertically, except if the range has a height of exactly 1 row ''' Args: ''' TargetRange : the range as a string that should receive a new value -''' Value: a scalar, a vector or an array with the new values for each cell o.XSpreadsheet.Name)f the range. +''' Value: a scalar, a vector or an array with the new values for each cell of the range. ''' The new values should be strings, numeric values or dates. Other types empty the corresponding cell ''' Returns: ''' A string representing the updated range @@ -3087,7 +3087,7 @@ Try: Set oAddress = _ParseAddress(TargetRange) With oAddress ' Convert to data array and limit its size to the size of the initial range - vDataArray = _ConvertToDataArray(Value, .Height - 1, .Width - 1) + vDataArray = ScriptForge.SF_Array.ConvertToDataArray(Value, IsRange := True, Rows := .Height, Columns := .Width) If UBound(vDataArray) < LBound(vDataArray) Then GoTo Finally .XCellRange.setDataArray(vDataArray) sSet = .RangeName @@ -3986,7 +3986,7 @@ Try: ' Apply the formula and get the result as an array of Boolean values. Clean up SetFormula(oFormulaRange, psFilterFormula) vDataArray = oFormulaRange.XCellRange.getDataArray() - vFilter = _ConvertFromDataArray(vDataArray) + vFilter = ScriptForge.SF_Array.ConvertFromDataArray(vDataArray) iDims = ScriptForge.SF_Array.CountDims(vFilter) ClearAll(oFormulaRange) @@ -4041,202 +4041,6 @@ Finally: End Function ' SFDocuments.SF_Calc._ComputeFilter REM ----------------------------------------------------------------------------- -Public Function _ConvertFromDataArray(ByRef pvDataArray As Variant) As Variant -''' Convert a data array to a scalar, a vector or a 2D array -''' Args: -''' pvDataArray: an array as returned by the XCellRange.getDataArray or .getFormulaArray methods -''' Returns: -''' A scalar, a zero-based 1D array or a zero-based 2D array of strings and/or doubles -''' To convert doubles to dates, use the CDate builtin function - -Dim vArray As Variant ' Return value -Dim lMax1 As Long ' UBound of pvDataArray -Dim lMax2 As Long ' UBound of pvDataArray items -Dim i As Long -Dim j As Long - - vArray = Empty - -Try: - ' Convert the data array to scalar, vector or array - lMax1 = UBound(pvDataArray) - If lMax1 >= 0 Then - lMax2 = UBound(pvDataArray(0)) - If lMax2 >= 0 Then - If lMax1 + lMax2 > 0 Then vArray = Array() - Select Case True - Case lMax1 = 0 And lMax2 = 0 ' Scalar - vArray = pvDataArray(0)(0) - Case lMax1 > 0 And lMax2 = 0 ' Vertical vector - ReDim vArray(0 To lMax1) - For i = 0 To lMax1 - vArray(i) = pvDataArray(i)(0) - Next i - Case lMax1 = 0 And lMax2 > 0 ' Horizontal vector - ReDim vArray(0 To lMax2) - For j = 0 To lMax2 - vArray(j) = pvDataArray(0)(j) - Next j - Case Else ' Array - ReDim vArray(0 To lMax1, 0 To lMax2) - For i = 0 To lMax1 - For j = 0 To lMax2 - vArray(i, j) = pvDataArray(i)(j) - Next j - Next i - End Select - End If - End If - -Finally: - _ConvertFromDataArray = vArray -End Function ' SFDocuments.SF_Calc._ConvertFromDataArray - -REM ----------------------------------------------------------------------------- -Private Function _ConvertToCellValue(ByVal pvItem As Variant) As Variant -''' Convert the argument to a valid Calc cell content - -Dim vCell As Variant ' Return value - -Try: - Select Case ScriptForge.SF_Utils._VarTypeExt(pvItem) - Case V_STRING : vCell = pvItem - Case V_DATE : vCell = CDbl(pvItem) - Case ScriptForge.V_NUMERIC : vCell = CDbl(pvItem) - Case ScriptForge.V_BOOLEAN : vCell = CDbl(Iif(pvItem, 1, 0)) - Case Else : vCell = "" - End Select - -Finally: - _ConvertToCellValue = vCell - Exit Function -End Function ' SFDocuments.SF_Calc._ConvertToCellValue - -REM ----------------------------------------------------------------------------- -Private Function _ConvertToDataArray(ByRef pvArray As Variant _ - , Optional ByVal plRows As Long _ - , Optional ByVal plColumns As Long _ - ) As Variant -''' Create a 2-dimensions nested array (compatible with the ranges .DataArray property) -''' from a scalar, a 1D array or a 2D array -''' Input may be a 1D array of arrays, typically when call issued by a Python script -''' Array items are converted to (possibly empty) strings or doubles -''' Args: -''' pvArray: the input scalar or array. If array, must be 1 or 2D otherwise it is ignored. -''' plRows, plColumns: the upper bounds of the data array -''' If bigger than input array, fill with zero-length strings -''' If smaller than input array, truncate -''' If plRows = 0 and the input array is a vector, the data array is aligned horizontally -''' They are either both present or both absent -''' When absent -''' The size of the output is fully determined by the input array -''' Vectors are aligned vertically -''' Returns: -''' A data array compatible with ranges .DataArray property -''' The output is always an array of nested arrays - -Dim vDataArray() As Variant ' Return value -Dim vVector() As Variant ' A temporary 1D array -Dim vItem As Variant ' A single input item -Dim iDims As Integer ' Number of dimensions of the input argument -Dim lMin1 As Long ' Lower bound (1) of input array -Dim lMax1 As Long ' Upper bound (1) -Dim lMin2 As Long ' Lower bound (2) -Dim lMax2 As Long ' Upper bound (2) -Dim lRows As Long ' Upper bound of vDataArray -Dim lCols As Long ' Upper bound of vVector -Dim bHorizontal As Boolean ' Horizontal vector -Dim bDataArray As Boolean ' Input array is already an array of arrays -Dim i As Long -Dim j As Long - -Const cstEmpty = "" ' Empty cell - - If IsMissing(plRows) Or IsEmpty(plRows) Then plRows = -1 - If IsMissing(plColumns) Or IsEmpty(plColumns) Then plColumns = -1 - - vDataArray = Array() - -Try: - ' Check the input argument and know its boundaries - iDims = ScriptForge.SF_Array.CountDims(pvArray) - If iDims = 0 Or iDims > 2 Then Exit Function - lMin1 = 0 : lMax1 = 0 ' Default values - lMin2 = 0 : lMax2 = 0 - Select Case iDims - Case -1 ' Scalar value - Case 1 - bHorizontal = ( plRows = 0 And plColumns > 0 ) - bDataArray = IsArray(pvArray(0)) - If Not bDataArray Then - If Not bHorizontal Then - lMin1 = LBound(pvArray) : lMax1 = UBound(pvArray) - Else - lMin2 = LBound(pvArray) : lMax2 = UBound(pvArray) - End If - Else - iDims = 2 - lMin1 = LBound(pvArray) : lMax1 = UBound(pvArray) - lMin2 = LBound(pvArray(0)) : lMax2 = UBound(pvArray(0)) - End If - Case 2 - lMin1 = LBound(pvArray, 1) : lMax1 = UBound(pvArray, 1) - lMin2 = LBound(pvArray, 2) : lMax2 = UBound(pvArray, 2) - End Select - - ' Set the output dimensions accordingly - If plRows >= 0 Then ' Dimensions of output are imposed - lRows = plRows - lCols = plColumns - Else ' Dimensions of output determined by input argument - lRows = 0 : lCols = 0 ' Default values - Select Case iDims - Case -1 ' Scalar value - Case 1 ' Vectors are aligned vertically - lRows = lMax1 - lMin1 - Case 2 - lRows = lMax1 - lMin1 - lCols = lMax2 - lMin2 - End Select - End If - ReDim vDataArray(0 To lRows) - - ' Feed the output array row by row, each row being a vector - For i = 0 To lRows - ReDim vVector(0 To lCols) - For j = 0 To lCols - If i > lMax1 - lMin1 Then - vVector(j) = cstEmpty - ElseIf j > lMax2 - lMin2 Then - vVector(j) = cstEmpty - Else - Select Case iDims - Case -1 : vItem = _ConvertToCellValue(pvArray) - Case 1 - If bHorizontal Then - vItem = _ConvertToCellValue(pvArray(j + lMin2)) - Else - vItem = _ConvertToCellValue(pvArray(i + lMin1)) - End If - Case 2 - If bDataArray Then - vItem = _ConvertToCellValue(pvArray(i + lMin1)(j + lMin2)) - Else - vItem = _ConvertToCellValue(pvArray(i + lMin1, j + lMin2)) - End If - End Select - vVector(j) = vItem - End If - vDataArray(i) = vVector - Next j - Next i - -Finally: - _ConvertToDataArray = vDataArray - Exit Function -End Function ' SFDocuments.SF_Calc._ConvertToDataArray - -REM ----------------------------------------------------------------------------- Private Function _DFunction(ByVal psFunction As String _ , Optional ByVal Range As Variant _ ) As Double |