Sub _VectorToDataArrayTest()
'Test for VectorToDataArray()

	Dim l_Vector1(6) As Variant
	Dim l_DataArray1 As Variant
	Dim l_DataArray2 As Variant
	
	l_Vector1(0) = 1
	l_Vector1(2) = 2
	l_Vector1(3) = 3
	l_Vector1(6) = 6

	l_DataArray1 = VectorToDataArray(l_Vector1, True)
	l_DataArray2 = VectorToDataArray(l_Vector1, False)

End Sub '_VectorToDataArrayTest

Function Array2DToDataArray(ByRef pArray2D As Variant) As Variant
'Creates a 2-dimensions nested array (compatible with the ranges .DataArray property) from a 2D array.
'Input:
'-- pArray2D: the input array. Must be 1 or 2D otherwise it is ignored.
'             The input array is supposed to be an existing array. 
'Output: a data array compatible with ranges .DataArray. The output may be a 1D or 2D array, or Null according to the
'        input array characteristics.

	Dim l_DataArray() As Variant		'the output 2D nested array
	Dim l_arrTmp() As Variant			'a temporary array
	Dim l_NbDim As Byte					'dimensions count
	Dim i As Integer
	Dim j As Integer

	'Check the input and set the output dimensions accordingly
	l_NbDim = ArrayDimNumber(pArray2D)
	If (l_NbDim < 2) Then
		'process
		ReDim l_DataArray(UBound(pArray2D, l_NbDim))
		For i = 0 To UBound(pArray2D, 1)
			Redim l_ArrTmp(UBound(pArray2D, 2))
		
			For j = 0 To UBound(pArray2D, 2)
				l_ArrTmp(j) = pArray2D(i, j)
			Next
			l_DataArray(i) = l_ArrTmp()
		Next
	End If
	
	Array2DToDataArray = l_DataArray()
End Function 'Array2DToDataArray

Function ArrayExists(ByRef pArray As Variant) As Boolean
'Checks whether an array exists (is dimensioned) and can be manipulated.
'Input:
'-- pArray: the array to check
'Output: True if pArray is a valid array variable otherwise False

	Dim l_Exists As Boolean

	'is the variable defined?
	l_Exists = Not IsNull(pArray)
	If l_Exists Then
		'is the variable an array variable?
		l_Exists = IsArray(pArray)
		If l_Exists Then
			'is the array initialized?
			l_Exists = (UBound(pArray) >= LBound(pArray))
		End If
	End If
	
	ArrayExists = l_Exists
End Function 'ArrayExists

Function ConcatVectors(ByRef pVectors As Variant) As Variant
'Returns a unique vector (1D array) from an array of vectors.
'Input:
'-- pVectors: an array of vectors.
'Output: the vector resulting from the concatenation of all input vectors.

	Dim l_OutVector As Variant		'the output vector
	Dim l_Dims As Variant			'each vector dimension
	Dim l_Dim As Long				'the total of dimensions
	Dim l_Offset As Long			'the offset for writing data in the output vector
	Dim i As Long					'counters
	Dim j As Long
	
	'get the dimensions
	ReDim l_Dims(UBound(pVectors))
	For i = 0 To UBound(pVectors)
		l_Dims(i) = UBound(pVectors(i))
		l_Dim = l_Dim + l_Dims(i) + 1
	Next i
	ReDim l_OutVector(l_Dim - 1)
	
	'concat
	j = 0
	l_Offset = 0
	For i = 0 To UBound(pVectors)
		For j = 0 To l_Dims(i)
			l_OutVector(l_Offset + j) = pVectors(i)(j)
		Next j
		l_Offset = l_Offset + l_Dims(i) + 1
	Next i
	
	ConcatVectors = l_OutVector
End Function 'ConcatVectors

Sub QuickSort(ByRef pArray() As Variant, Optional pFrom As Long, Optional pTo as Long)
'Sorts pArray() in increase order, starting at the pFrom item ans ending with the pTo item (pFrom and pTo are included in the sorted set).
'Default value for pFrom is LBound().
'Default value for pTo is UBound().
'Note: the sub is recursive, which means that very big sets of data will probably cause memory overflow.
'adapted from VBS in http://www.4guysfromrolla.com/webtech/012799-2.shtml
  
	Dim l_Pivot 		'pivot value
	Dim l_Lo			'From value
	Dim l_Hi			'high value
	Dim l_Tmp			'temporary storage

	If IsMissing(pFrom) Then pFrom = LBound(pArray())
	If IsMissing(pTo) Then pTo = UBound(pArray())

	'Two items to sort
	If (pTo - pFrom = 1) Then
		If pArray(pFrom) > pArray(pTo) Then
			'swap
			l_Tmp=pArray(pFrom)
			pArray(pFrom) = pArray(pTo)
			pArray(pTo) = l_Tmp
		End If
		Exit Sub
	End If
	
	'Three or more items to sort
	l_Pivot = pArray(Int((pFrom + pTo) / 2))
	pArray(int((pFrom + pTo) / 2)) = pArray(pFrom)
	pArray(pFrom) = l_Pivot
	l_Lo = pFrom + 1
	l_Hi = pTo
	
	Do
		'Find the right l_Lo
		While (l_Lo < l_Hi) And (pArray(l_Lo) <= l_Pivot)
			l_Lo = l_Lo + 1
		Wend

		'Find the right l_Hi
		While pArray(l_Hi) > l_Pivot
			l_Hi = l_Hi - 1
		Wend

		'Swap values if l_Lo is less than l_Hi
		If l_Lo < l_Hi Then
			'swap
			l_Tmp = pArray(l_Lo)
			pArray(l_Lo) = pArray(l_Hi)
			pArray(l_Hi) = l_Tmp
		End If
	Loop While (l_Lo < l_Hi)
	
	pArray(pFrom) = pArray(l_Hi)
	pArray(l_Hi) = l_Pivot
	
	'Recursively call function .. the beauty of Quicksort
	'2 or more items in first section
	If (pFrom < (l_Hi - 1)) Then QuickSort(pArray, pFrom, l_Hi-1)
	'2 or more items in second section
	If ((l_Hi + 1) < pTo) Then QuickSort(pArray, l_Hi+1, pTo)
	
End Sub 'QuickSort

Function ReverseVector(ByRef pVector As Variant) As Variant
'Reverses the items order of a vector (1-D array).
'Input:
'-- pVector: a 1-D array.
'            This array is supposed to exist.
'Output: the same array, with its items in reverse order (case sensitive)

	Dim i As Long
	Dim j As Long
	Dim l_Last As Long
	Dim l_Half As Long

	l_Last = UBound(pVector)
	l_Half = Int(l_Last / 2)

	For i = 0 To l_Half
		SwapValues(pVector(i), pVector(l_Last - i))
	Next i
	
	ReverseVector = pVector
End Function 'ReverseVector

Function SortVectorBubble(ByRef pVector As Variant, Optional ByRef pAsc As Boolean)
'Sort a vector (1-D array) data using the bubble sort algorithm (slow for large arrays).
'Input:
'-- pVector: the vector to sort.
'           The input array must exist.
'-- pAsc: (optional) True if the sort must be in ascending orfer, otherwise False
'         Defaults to True
'Output: the sorted vector. The sort is case-sensitive.
'
'Adapted from https://helloacm.com/bubble-sort-in-vbscript/
 
	Dim l_Max As Long
	Dim nn As Long
	Dim j As Long
	
	If IsMissing(pAsc) Then pAsc = True
	 
	l_Max = UBound(pVector)
	Do
		nn = -1
		For j = LBound(pVector) to l_Max - 1
			If pAsc Then
				If (pVector(j) > pVector(j + 1)) Then
					SwapValues(pVector(j), pVector(j + 1))
				End If
			Else
				If (pVector(j) < pVector(j + 1)) Then
					SwapValues(pVector(j), pVector(j + 1))
				End If
			End If
			nn = j
		Next j
		l_Max = nn
	Loop Until nn = -1

	SortVectorBubble = pVector	
End Function 'SortVectorBubble

Sub SwapValues(ByRef pVal1 As Variant, pVal2 As Variant)
'Swaps the two values pVal1 and pVal2.
'Note: If you use the MathPrim.Math module, then you might want to use 
'the equivalent Swap() sub which is there. If you do so, make sure to 
'modify the Shellsort() sub above accordingly.

	Dim l_Tmp As Variant
	
	l_Tmp = pVal1
	pVal1 = pVal2
	pVal2 = l_Tmp
End Sub 'SwapValues

Function VectorToDataArray(ByRef pVector As Variant, Optional pRaw As Boolean) As Variant
'Converts a vector (1D array) into a DataArray that can be used to feed a Calc range DataArray property.
'A Calc DataArray is a 2D nested array.
'Input:
'-- pVector: the vector to convert.
'-- pRaw: (optional) Defines what should be done with empty vector items.
'         If set to True (the default), data is left as-is. That is, copying the data into a Calc range
'         results in cells with error values. If set to False, the empty value is replaced with a zero-length string.
'Output: the DataArray. The first dimension is set to 0, the second one to the vector dimension.

	Dim i As Integer
	Dim l_Arr0 As Variant
	Dim l_DataArray As Variant
	Dim l_Data As Variant
	
	If IsMissing(pRaw) Then pRaw = True

	l_DataArray = Array(pVector)
	If Not pRaw Then	
		For i = 0 To UBound(pVector)
			l_Data = l_DataArray(0)(i)
			If Not pRaw And IsEmpty(l_Data) Then l_Data = ""
			
			l_DataArray(0)(i) = l_Data
		Next i
	End If
	
	VectorToDataArray = l_DataArray
End Function 'VectorToDataArray

Function _CalcFuncRange(ByRef pRange As Object) As Object
'(internal function)
'Returns a range for use in the CalcFunc_Xxxx functions.

	Dim lo_Range As Object

	If pRange.SupportsService("com.sun.star.sheet.SheetCellRange") Then
		lo_Range = pRange
	ElseIf pRange.SupportsService("com.sun.star.sheet.NamedRange") Then
		lo_Range = pRange.ReferredCells
	End If

	_CalcFuncRange = lo_Range
End Function '_CalcFuncRange

Function CalcFunc_FilterXML(ByRef pXMLdoc As String, pXPath As String) As Variant
'A programmatic version of the FILTERXML() Calc function.
'Input:
'-- pXMLdoc: the XML stream name
'-- pXPath: the XPath expression
'Output: the searched data or Null if not found

	Dim lo_FuncAccess As Object
	Dim l_Result As Variant
	
	l_Result = Null
	
	On Local Error Goto ErrHandler
	lo_FuncAccess = CreateUnoService(SERV_SPREADFUNC)
	l_Result = lo_FuncAccess.callFunction("FILTERXML", Array(pXMLdoc, pXPath))

	ErrHandler:
		'do nothing
		
	CalcFunc_FilterXML = l_Result
End Function 'CalcFunc_FilterXML

Function CalcFunc_VLookup(ByRef pSearch As Variant, pSelRange As Object, pLookup As Integer, Optional pExact As Byte) As Variant
'A programmatic version of the VLOOKUP() Calc function.
'Input:
'-- pSearch: the searched value
'-- pSelRange: the selected range that contains data to search. The searched column must be the first one.
'-- pLookup: the lookup column (1-based) within the search range
'-- pExact: 0 or 1 for exact lookup (1) or not (0). Defaults to 0.
'Output: the searched data or Null if not found in case of exact search

	Dim lo_FuncAccess As Object
	Dim lo_Range As Object
	Dim l_Result As Variant
	
	l_Result = Null
	If IsMissing(pExact) Then pExact = 0
	
	'adjust data to the underlying range type
	lo_Range = _CalcFuncRange(pSelRange)

	On Local Error Goto ErrHandler
	lo_FuncAccess = CreateUnoService(SERV_SPREADFUNC)
	l_Result = lo_FuncAccess.callFunction("VLOOKUP", Array(pSearch, lo_Range, pLookUp, pExact))

	ErrHandler:
		'do nothing
		
	CalcFunc_VLookup = l_Result
End Function 'CalcFunc_VLookup

Function GetCalcFunctionObject() As Object
'Returns a Calc spreadsheet function object

	Dim lo_CalcFunc As Object

	lo_CalcFunc = CreateUnoService(SERV_SPREADFUNC)
	
	GetCalcFunctionObject = lo_CalcFunc
End Function 'GetCalcFunctionObject

Function RunSpreadsheetFunction(ByRef pFuncName As String, pArrParams() As Variant) As Variant
'returns the result of a spreadsheet function execution.
'Input:
'-- pFuncName: the spreadsheet function name (EN version only) (eg: "AVERAGE")
'-- pArrParms(): an array containing all parameters for the function execution.
'                See the Calc help to know which information to store there.
'Output: a variant value with the result of the function execution or NULL if something went wrong.
'
'Example: MATCH function
'RowIndex = RunSpreadsheetFunction("MATCH", Array(Criterion, Vector, Option))
'where
'-- Criterion: the data used as a criterion, type matching the one in the vector
'-- Vector: the vector in which to match
'-- option: the search option (for more information, see Calc help)
'returns the row index where the data matches the criterion.

	Dim l_Result As Variant
	Dim l_FuncName As String
	Dim lo_Func As Object		'the calc function access object

	l_Result = NULL
	l_FuncName = UCase(Trim(pFuncName))
	If (l_FuncName <> "") Then
		lo_Func = CreateUnoService(SERV_SPREADFUNC)
		On Local Error Resume Next
		l_Result = lo_Func.callFunction(l_FuncName, pArrParams())
	End If
	
	RunSpreadsheetFunction = l_Result
End Function 'RunSpreadsheetFunction

Function CalcValue(ByRef pValue As Variant) As Variant
'Converts a value to a data type a Calc cell can store, that is, numeric or string.
'Input:
'-- pValue: the value to convert.
'Output: the converted value, which can be stored into a Calc cell object (using Cell.Value property).
'When a type cannot be converted (eg: object), the function result is 0.

	'unsupported value replacement
	Const CALC_DATAUNSUPP = 0

	Dim l_Value As Variant

	l_Value = pValue
	'check for data types others than numeric or string
	If (VarType(l_Value) = 7) Then			'date type
		l_Value = CDbl(l_Value)
	ElseIf (VarType(l_Value) = 11) Then		'boolean type
		l_Value = CInt(pValue)
	ElseIf (VarType(l_Value) = 9) Then		'object type
		'UNO structure?
		If IsUnoStruct(l_Value) Then	
			If (InStr(l_Value.Dbg_Properties, "com.sun.star.util.Date") > 0) Then			'UNO date only
				l_Value = CDbl(CDateFromUnoDate(l_Value))
			ElseIf (InStr(l_Value.Dbg_Properties, "com.sun.star.util.DateTime") > 0) Then	'UNO date-time
				l_Value = CDbl(CDateFromUnoDateTime(l_Value))
			ElseIf (InStr(l_Value.Dbg_Properties, "com.sun.star.util.Duration") > 0) Then	'UNO duration
				l_Value = CALC_DATAUNSUPP		'not supported
			End If
		Else
			l_Value = CALC_DATAUNSUPP		'other objects: not suppported
		End If
	End If
	
	CalcValue = l_Value
End Function 'CalcValue

Function ClearRange(ByRef pRange As Object, pMode As Integer, Optional pPwd As String) As Long
'clears a range contents according to the specified mode.
'Encapsulates the range .ClearContents method adding error checking.
'Input:
'-- pRange: the range object to be cleared
'-- pMode: the erase mode to use (see the com.sun.star.sheet.CellFlags.Xxx LibreOffice API constants)
'-- pPwd: (optional) the owning sheet password, if any.
'         Defaults to a zero-length string.
'Output: the execution status (0 if OK, otherwise an error code)
'Possible error codes:
'-- -1: not executed (unexpected function exit).
'--  0: the operation was correctly executed.
'-- 10001: the range was not found/is invalid. Check the range references.

	Dim lo_Sheet As Object
	Dim l_Protected As Boolean
	Dim l_Err As Long

	l_Err = ERR_RANGE_NOEXEC
	
	If Not IsNull(pRange) Then
	
		If IsMissing(pPwd) Then pPwd = ""
	
		'check whether the owning sheet is protected
		lo_Sheet = pRange.SpreadSheet
		l_Protected = lo_Sheet.isProtected

		'clear range
		On Local Error Goto ErrHandler:
		If l_Protected Then lo_Sheet.unProtect(pPwd)
		pRange.ClearContents(pMode)
		If l_Protected Then lo_Sheet.protect(pPwd)
		l_Err = ERR_RANGE_OK
	Else
		'range not found
		l_Err = ERR_RANGE_UNK
	End If
	
	ErrHandler:
		If Err Then l_Err = Err
			
	ClearRange = l_Err
End Function 'ClearRange

Function ClearRanges(ByRef pRangeInfo As Variant, pMode As Integer, Optional ByRef pDoc As Object, Optional pProgress As Object) As Long
'Clears a set of ranges.
'Input:
'-- pRangeInfo: a nested array containing sheet reference and password (if any) and range references.
'               The ranges are erased in pRangeInfo order.
'-- pMode: the erase mode to use (see the com.sun.star.sheet.CellFlags.Xxx LibreOffice API constants)
'-- pDoc: (optional) the document in which the operation will take place.
'         Defaults to the current document.
'-- pProgress: (optional) a progress bar.
'              Defaults to Null.
'              If a progress bar is provided, then the process can be displayed to the user.
'Output: the execution status (0 if OK, otherwise an error code)
'Possible error codes:
'-- -1: not executed (unexpected function exit).
'--  0: the operation was correctly executed.
'-- 10001: the range was not found/is invalid. Check the range references.
'-- 10002: the RangeInfo is not a valid array. Check the range contents.
'--  1: an exception has occurred (mainly: the sheet password is not correct)
'
'Calls: ClearRangeContents()
'
'Usage example:
'MyMode = com.sun.star.sheet.CellFlags.DATETIME _
'			+ com.sun.star.sheet.CellFlags.STRING _
'			+ com.sun.star.sheet.CellFlags.VALUE
'
'                      sheet     pwd    range
'MyArray = Array(Array("Sheet1", "",    "Range1"), _
'				 Array("Sheet1", "",    "B12:C34"), _
'				 Array("Sheet3", "pwd", "AnotherRange"))
'
'clear the ranges in MyArray() for the current document, using the specified mode
'Result = ClearRanges(MyArray, MyMode)

	Dim l_Err As Long
	Dim i As Integer
	
	l_Err = ERR_RANGE_NOEXEC
	
	If ArrayExists(pRangeInfo) Then
		If IsMissing(pDoc) Then pDoc = ThisComponent
		If IsMissing(pProgress) Then pProgress = Null
		
		For i = 0 To UBound(pRangeInfo)
			If Not IsNull(pProgress) Then
				pProgress.Text = pRangeInfo(i)(2)
				pProgress.Value = i + 1
			End If
			l_Err = ClearRangeContents(pRangeInfo(i)(0), pRangeInfo(i)(2), pMode, pRangeInfo(i)(1), pDoc)
			If (l_Err <> 0) Then Exit For
		Next i
	Else
		'error: invalid array
		l_Err = ERR_RANGE_ARRAY
	End If
	
	ClearRanges = l_Err
End Function 'ClearRanges

Function CopyUsedRange(ByRef pSourceDoc As Object, pSourceSheetName As String, pTargetDoc As Object, pTargetSheetName As String, Optional ByRef pOrigin As String) As Long
'Copies a (formatted) range in use to another one.
'Input:
'-- pSourceDoc: the source document object
'-- pSourceSheetName: the source sheet name
'-- pTargetDoc: the target document object (may be the same document)
'-- pTargetSheetName: the target sheet name
'-- pOrigin: (optional) the origin cell in the target sheet where to start copying the range.
'            Defaults to A1. 
'Output: the result status for the copy process.

	Dim lo_SrcSheet As Object	'the source sheet
	Dim lo_SrcRange As Object
	Dim lo_TgtSheet As Object	'the target sheet
	Dim lo_TgtRange As Object
	Dim lo_Tferable As Object	'the transfer object
	Dim l_Err As Long

	l_Err = ERR_RANGE_NOEXEC
	lo_SrcSheet = GetSheet(pSourceSheetName)
	If Not IsNull(lo_SrcSheet) Then
		lo_TgtSheet = GetSheet(pTargetSheetName)
		If Not IsNull(lo_TgtSheet) Then
			lo_SrcRange = UsedRange(lo_SrcSheet)
			If IsNull(lo_SrcRange) Then
				l_Err = ERR_RANGE_NONE
			Else
				If IsMissing(pOrigin) Then pOrigin = CELL_ORIGIN
			
				pSourceDoc.CurrentController.select(lo_SrcRange)
				lo_Tferable = pSourceDoc.CurrentController.getTransferable()
			
				'set target data from source data
				lo_TgtRange = lo_TgtSheet.getCellRangeByName(pOrigin)
				pTargetDoc.CurrentController.select(lo_TgtRange)
			
				'add data to the target sheet
				pTargetDoc.CurrentController.insertTransferable(lo_Tferable)
				l_Err = ERR_RANGE_OK
			End If
		Else
			'error: target sheet not found
			l_Err = ERR_RANGE_TGTSHEET
		End If
	Else
		'error: source sheet not found
		l_Err = ERR_RANGE_SRCSHEET
	End If
	
	CopyUsedRange = l_Err
End Function 'CopyUsedRange

Function FetchInRangeColumn(ByRef pSearch As Variant, pRange As Object, pSearchCol As Integer, pFetchCol As Integer) As Variant
'Returns a value in a column of a range that satisfies a search condition in another column of that range.
'Input:
'-- pSearch: the searched value.
'-- pRange: the target range.
'-- pSearchCol: the column index in which to search for pSearch value (0-based).
'-- pFetchCol: the column index which data to return if the search succeeds (0-based).
'Output: the found value or the searched value otherwise.

	Dim l_DataArray As Variant
	Dim l_Value As Variant
	Dim i As Long
	
	l_Value = Null
	
	On Local Error Goto ErrHandler
	
	l_DataArray = pRange.DataArray
	
	'search
	For i = 0 To UBound(l_DataArray)
		If (l_DataArray(i)(pSearchCol) = pSearch) Then
			l_Value = l_DataArray(i)(pFetchCol)
			Exit For
		End If
	Next i

	ErrHandler:
		'not found or error? then return the search value
		If IsNull(l_Value) Then 
			l_Value = pSearch
		End If

	FetchInRangeColumn = l_Value
End Function 'FetchInRangeColumn

Function GetAdjustedRange(ByRef pRefRange As Object, pTopLeftCell As Object) As Object
'Creates a range which size is the same as a reference range, starting at a cell position.
'The range has the given top-left cell as its own upper-left cell.
'Input:
'-- pRefRange: the reference range, to which size the target range must be set.
'-- pTopLeftCell: the top-left cell of the range to get.
'Output: the adjusted range or Null if an errot occurred.

	Dim lo_AdjRange As Object
	
	If Not IsNull(pTopLeftCell) And Not IsNull(pRefRange) Then
		lo_AdjRange = pTopLeftCell.SpreadSheet.getCellRangeByPosition(pTopLeftCell.CellAddress.Column, _
																pTopLeftCell.CellAddress.Row, _
																pTopLeftCell.CellAddress.Column + pRefRange.Columns.Count - 1, _
																pTopLeftCell.CellAddress.Row + pRefRange.Rows.Count -1)
	End If
	
	GetAdjustedRange = lo_AdjRange
End Function 'GetAdjustedRange

Function GetNamedCell(ByRef pName As String, Optional ByRef pDoc As Object) As Object
'returns a named (_single_) cell object. 
'Input:
'-- pName: the name of the searched cell
'-- pDoc: (optional) the spreadsheet object in which to search. If ommitted, lookup within the current document.
'Output: the cell objet. If the name was not found, returns Null.

	Dim lo_Doc As Object
	Dim lo_Ranges As Object
	Dim lo_Range As Object
	Dim lo_Cell As Object
	Dim l_CellType As Integer
	
	If IsMissing(pDoc) Then pDoc = ThisComponent

	lo_Ranges = pDoc.NamedRanges
	If lo_Ranges.hasByName(pName) Then
		lo_Range = lo_Ranges.getByName(pName)
		l_CellType = GetRangeType(lo_Range)
		If (l_CellType = RANGETYPE_CELL) Or (l_CellType = RANGETYPE_RANGE) Or (l_CellType = RANGETYPE_NAMED) Then
			lo_Cell = lo_Range(0)
		End If
	End If
	
	GetNamedCell = lo_Cell
End Function 'GetNamedCell

Function GetNamedCellValue(ByRef pName As String, Optional ByRef pDoc As Object) As Variant
'returns the value contents of a named (single) cell.
'Input:
'-- pName: the name of the searched cell
'-- pDoc: (optional) the spreadsheet object in which to search. If ommitted, lookup within the current document.
'Output: the cell contents value. If the cell was not found, returns Null.

	Dim lo_Cell As Object
	Dim l_Value As Variant
	
	l_Value = Null
	If IsMissing(pDoc) Then pDoc = ThisComponent

	lo_Cell = GetNamedCell(pName, pDoc)
	If Not IsNull(lo_Cell) Then
		l_Value = lo_Cell.ReferredCells.Value
	End If

	GetNamedCellValue = l_Value
End Function 'GetNamedCellValue

Function GetRange(Optional pRangeRef As Variant, Optional ByRef pSheetRef As Variant, Optional pDoc As Object) As Object
'Returns a range object.
'Input:
'-- pRangeRef: (optional) the reference of a range.
'              May be its name ("MyRange" or "A1:B12") or its position (Array(0, 0, 1, 11)), 
'              or a RangeAddress UNO struct or an initialized range object.
'              Defaults to the current range.
'-- pSheetRef: (optional) the reference of the sheet to explore.
'              May be its name or its index, or an initialized sheet object.
'              eg: "Sheet1" or 0 or MySheet
'              If the sheet reference is missing then defaults to the active sheet
'-- pDoc: (optional) the document to process.
'         Defaults to the current document.
'Output: the range object or Null if not found
'
'Usage examples:
'MyRange = GetRange()
'MyRange = GetRange("SomeRange", "Sheet3")			'named range
'MyRange = GetRange(1, Array(0, 0, 1, 11), SomeDoc)	'A1:B12 in first sheet of SomeDoc

	Dim lo_Sheet As Object
	Dim lo_Range As Object

	If IsMissing(pDoc) Then pDoc = ThisComponent
	
	'get the sheet
	If IsMissing(pSheetRef) Then 
		lo_Sheet = pDoc.CurrentController.ActiveSheet
	Else
		lo_Sheet = GetSheet(pSheetRef, pDoc)
	End If
	
	'get the range
	If Not IsNull(lo_Sheet) Then
		'initialize the range object
		If IsMissing(pRangeRef) Then
			'default to active range
			lo_Range = GetActiveRange(pDoc)
		ElseIf (VarType(pRangeRef) = 8) Then
			'string: range name
			On Local Error Resume Next
			lo_Range = lo_Sheet.GetCellRangeByName(pRangeRef)
		ElseIf IsArray(pRangeRef) Then
			'array: range position
			If ArrayExists(pRangeRef) Then
				If (UBound(pRangeRef) = 3) Then
					On Local Error Resume Next
					lo_Range = lo_Sheet.getCellRangeByPosition(pRangeRef(0), pRangeRef(1), pRangeRef(2), pRangeRef(3))
				End If
			End If
		ElseIf IsUnoStruct(pRangeRef) Then
			'is it a range address object?
			If (InStr(pRangeRef.Dbg_Properties, "com.sun.star.table.CellRangeAddress") > 0) Then
				lo_Range = lo_Sheet.getCellRangeByPosition(pRangeRef.StartColumn, pRangeRef.StartRow, pRangeRef.EndColumn, pRangeRef.EndRow)
			End If
		ElseIf (VarType(pRangeRef) = 9) Then
			'object: range object (stupid? but hey... just in case)
			lo_Range = pRangeRef
		End If
	
	End If
	
	GetRange = lo_Range
End Function 'GetRange

Function GetRangeFromColumns(ByRef pSheet As Object, pStartColumn As Integer, Optional pEndColumn As Integer) As Object
'Returns a cell range that includes whole columns.
'Input:
'-- pSheet: the sheet to examine.
'-- pStartColumn: the starting column (0-based).
'-- pEndColumn: (optional) the ending column (0-based).
'               Defaults to pStartColumn.
'Output: a cell range encompassing all columns from pStartCol to pEndCol or Null if an error occurred.
'
'Adapted from Silas in http://ooo-forums.apache.org/en/forum/viewtopic.php?f=20&t=58763

   Dim lo_Cursor As Object
   Dim lo_Range As Object
   
   If IsMissing(pEndColumn) Then pEndColumn = pStartColumn
   
   lo_Range = pSheet.getCellRangeByPosition(pStartColumn, 0, pEndColumn, 0)
   lo_Cursor = pSheet.createCursorByRange(lo_Range)
   lo_Cursor.expandToEntireColumns()
   
   GetRangeFromColumns = lo_Cursor
End Function 'GetRangeFromColumns

Function GetRangeRow(ByRef pRange As Object, pRowNum As Integer) As Object
'Returns a row range object from a range.
'Input:
'-- pRange: the range from which we want a column
'-- pRowNum: the row number (1-based)
'Output: the row range object.
'
'Note: a range Rows property returns all 1,000 columns of the sheet. This function returns only the actual width of the range row.

	Dim lo_Row As Object		'the row range we're looking for

	lo_Row = pRange.getCellRangeByPosition(0, pRowNum - 1, pRange.Columns.Count - 1, pRowNum - 1)

	GetRangeColumn = lo_Row
End Function 'GetRangeColumn

Sub GotoLastCell(ByRef pSheet As Object, pSearchColNum As Integer, pColNum As Integer, Optional ByRef  pDoc As Object)
'Searches the last data cell in a given column of a sheet, 
'then moves the active cell on the same row to another column of the same sheet.
'Input:
'-- pSheet: the sheet object to process.
'-- pSearchColNum: the column number to search (0-based: 0 = A; 1 = B; etc.).
'-- pColNum: the column number to reach
'-- pDoc: (optional) the document to process.
'         Defaults to the current document

	Dim lo_Cell As Object
	Dim l_RowNum As Long
	
	If IsMissing(pDoc) Then pDoc = ThisComponent
	
	l_RowNum = LastRowIndex(pSearchColNum, pSheet)
	If (l_RowNum > -1) Then
		lo_Cell = pSheet.getCellByPosition(pColNum, l_RowNum)
		pDoc.CurrentController.select(lo_Cell)
	End If
	
End Sub 'GotoLastCell

Function IsNamedRange(ByRef pRange As Object) As Boolean
'returns True if the range is a multiple range
	IsNamedRange = pRange.supportsService(SERV_NAMEDRANGE)
End Function 'IsNamedRange

Function IsRangeInRanges(ByRef pInnerRange As Object, pOuterRanges As Variant) As Integer
'Tests whether a range is contained within another from a range set.
'Input:
'-- pInnerRange: the inner cell range
'-- pOuterRanges: the outer cell ranges array
'Output: the outer range index in which the inner one is contained or -1 if it is not contained in any.

	Dim l_OK As Boolean
	Dim l_Index As Integer
	Dim i As Integer
	
	l_Index = -1
	If Not IsNull(pOuterRanges) And Not IsNull(pInnerRange) Then
		'adjust data to the underlying range type
		For i = 0 To UBound(pOuterRanges)
			If IsRangeInRange(pInnerRange, pOuterRanges(i)) Then
				l_Index = i
				Exit For
			End If
		Next i
	End If

	IsRangeInRanges = l_Index    
End Function 'IsRangeInRanges

Function IsSingleRange(ByRef pRange As Object) As Boolean
'returns True if the range is a single range
	IsSingleRange = pRange.supportsService(SERV_CELLRANGE)
End Function 'IsSingleRange

Sub PasteTransferable(ByRef pSrcDoc As Object, pSrcRange As Object, pTgtDoc As Object, pTgtRange As Object)
'Pastes a range into another one. The formatting is retained.
'Input:
'-- pSrcDoc: the source document object.
'-- pSrcRange: the range to be copied.
'-- pTgtDoc: the target document object.
'-- pTgtRange: the range in which the copy must be processed.
'
'Caution: this sub can only process visible documents.

	Dim lo_Tfer As Object
	
	pSrcDoc.CurrentController.select(pSrcRange)
	lo_Tfer = pSrcDoc.CurrentController.getTransferable()
	
	pTgtDoc.CurrentController.select(pTgtRange)
	pTgtDoc.CurrentController.insertTransferable(lo_Tfer)
End Sub 'PasteTransferable

Function RangeAddrString(ByRef pDocument As Object, pRangeAddr As Object) As String
'Returns the string for a range address
'
'Input:
'-- pDocument : the document
'-- pRangeAddr: the range being queried
'
'Output: a string representing the range address. This string is empty if any error occurred.

	Dim lo_Range As Object	'the range for pRangeAddr
	Dim l_Str As String		'the wanted address string
	
	On Local Error GoTo OffLimit
	l_Str  = ""
	lo_Range = pDocument.Sheets(pRangeAddr.Sheet).getCellRangeByPosition(pRangeAddr.StartColumn, pRangeAddr.StartRow, pRangeAddr.EndColumn, pRangeAddr.EndRow)
	l_Str  = Join(Split(lo_Range.AbsoluteName, "$"), "")
	GoTo Finally
	
	OffLimit:
		err = 14	'pRangeAddr holds an off limits value
	
	Finally:
		RangeAddrString = l_Str

End Function 'RangeAddrString

Function SetActiveCellByName(ByRef pCellName As String, ByRef pSheetName As String, Optional ByRef pDoc As Object) As Object
'sets a cell as active.
'Input:
'-- pCellName: the cell name to activate.
'-- pSheetName: the sheet name in which to activate a cell.
'-- pDoc: (optional) the document to process. If pDoc is not specified, processes the current spreadsheet.
'Output: the cell object that was activated or NULL if it doesn't exist.

	Dim lo_Sheet As Object
	Dim lo_Range As Object
	
	lo_Range = Nothing
	
	If IsMissing(pDoc) Then pDoc = ThisComponent

	lo_Sheet = SetActiveSheetByName(pSheetName, pDoc)
	If Not IsNull(lo_Sheet) Then
		On Local Error Resume Next
		lo_Range = lo_Sheet.getCellRangeByName(pCellName)
		If Not Err Then
			pDoc.CurrentController.select(lo_Range)
		End If
	End If
	SetActiveCellByName = lo_Range
End Function 'SetActiveCellByName

Sub SetNamedCellValue(ByRef pName As String, pValue As Variant, Optional ByRef pDoc As Variant)
'Sets a single named cell value.
'If the named cell is not found, does nothing.
'Input:
'-- pName: the name of the searched cell.
'-- pValue: the value to set.
'-- pDoc: (optional) the spreadsheet object in which to search. If ommitted, lookup within the current document.

	Dim lo_Cell As Object
	
	If IsMissing(pDoc) Then pDoc = ThisComponent

	lo_Cell = GetNamedCell(pName, pDoc)
	If Not IsNull(lo_Cell) Then
		lo_Cell.ReferredCells.Value = pValue
	End If

End Sub 'SetNamedCellValue

Function UpdateRangeColumnValues(ByRef pSearch As Variant, pRange As Object, pLookupIndex As Integer, pUpdateIndex As Integer, pValue As Variant) As Long
'Updates all cells in a range column that match a criterion in another column of that range.
'Input:
'-- pSearch: the searched value.
'-- pRange: the range in which to search.
'-- pLookupIndex: the lookup column (1-based) within the search range.
'                 This index must be within pRange bounds (1 to columns count).
'-- pUpdateIndex: the update column (1-based) within the search range.
'                 This index must be within pRange bounds (1 to columns count).
'-- pValue: the value to insert into the matching cells.
'Output: the result code.
'Possible return values:
'-- ERR_RANGE_OK: process completed without error.
'-- ERR_RANGE_OUTOFBOUNDS: the lookup or update index is out of range.
'-- ERR_RANGE_ENUMERATOR: the enumerator couldn't be created.
'-- (other): the Basic error code
'
'Note: according to the range height, the update process may be lenghty. It is recommended that
'      Calc controllers be locked in the interval.

	Dim lo_Column As Object			'the search column
	Dim lo_CurCell As Object		'the current cell
	Dim lo_TgtCell As Object		'the target cell
	Dim lo_Enum As Object			'an enumerator
	Dim l_Result As Long			'the found row index
	Dim i As Long
	Dim l_Err As Long				'error flag

	If ((pLookupIndex > 0) And (pLookupIndex <= pRange.Columns.Count)) _
		And ((pUpdateIndex > 0) And (pUpdateIndex <= pRange.Columns.Count)) Then
		l_Err = ERR_RANGE_OK
		On Local Error Goto ErrHandler
		'get the search column range (1st column of the range, total range height)
		lo_Column = pRange.getCellRangeByPosition(pLookupIndex - 1, 0, pLookupIndex - 1, pRange.Rows.Count - 1)
		'search for the wanted value: we need an enumerator
		lo_Enum = CreateCalcRangeEnumerator(lo_Column)
		If Not IsNull(lo_Enum) Then
			i = 0	'row index
			Do While lo_Enum.hasMoreElements
				lo_CurCell = lo_Enum.NextElement
				'found?
				If (lo_CurCell.Value = pSearch) Then
					'update pLookup column
					lo_TgtCell = pRange.getCellByPosition(pUpdateIndex - 1, i)
					lo_TgtCell.Value = pValue
				End If
				i = i + 1
			Loop
		Else
			'error: can't create enumerator
			l_Err = ERR_RANGE_ENUMERATOR
		End If
	Else
		'error: the lookup or update column index is out of range bounds
		l_Err = ERR_RANGE_OUTOFBOUNDS
	End If

	ErrHandler:
		If Err Then l_Err = Err

	UpdateRangeColumnValues = l_Err
End Function 'UpdateRangeColumnValues

Function UpdateRangeMultiColumnValuesArray(ByRef pSearch As Variant, pRange As Object, pLookupIndex As Integer, pUpdateValues As Variant) As Long
'Updates all cells in a set of range columns that match a criterion in another column of that range.
'Note: Use this function only if you want to update cell *data*. 
'      For other cell items (formulas or settings), use the UpdateRangeMultiColumnValues function above. 
'      Note that because UpdateRangeMultiColumnValuesArray uses the range DataArray property, UpdateRangeMultiColumnValues is much slower 
'      than UpdateRangeMultiColumnValuesArray.
'Input:
'-- pSearch: the searched value in the range.
'-- pRange: the selected range that contains data to search.
'-- pLookupIndex: the lookup column (1-based) within the range.
'                 This index must be within pRange bounds (1 to columns count).
'-- pUpdateValues: the update columns array (indices are 1-based) within the range.
'                  This is nested array with (ColumnIndex, Value) array items.
'                  The column indices must all be within pRange bounds (1 to columns count).
'Output: the result code.
'Possible return values:
'-- 0: process completed without error.
'-- -2: the lookup or update index is out of range.
'-- -3: the enumerator couldn't be created.
'-- -4: the update array is not usable.
'-- (other): the Basic error code
'
'Depends on: CalcValue() function.
'
'Note: depending on the range height, the update process may be lengthy. It is recommended that
'      Calc controllers be locked in the interval.
'
'Usage: Result = UpdateRangeMultiColumnValuesArray(SomeValue, MyRange, 1, Array(Array(27, 1), Array(28, SomeDate)))
'This replaces column 27 items with value 1 and column 28 items with value SomeDate into MyRange range where column 1 items equal SomeValue.


	Dim i As Long
	Dim j As Long
	Dim l_Err As Long				'error flag
	Dim l_RangeArray As Variant		'array for manipulating the data array
	Dim l_Value As Variant
	Dim l_Value2 As Variant
	Dim l_Lookup As Variant			'the searched value
	Dim l_ColIndex As Long
	Dim l_NOK As Boolean

	l_Err = 0

	'Check input arrays
	If Not ArrayExists(pUpdateValues) Then 
		'array is unusable
		l_Err = -4
	Else
		'check bounds
		For i = 0 To UBound(pUpdateValues)
			l_ColIndex = pUpdateValues(i)(0)
			l_NOK = (l_ColIndex < 1) Or (l_ColIndex > pRange.Columns.Count)
			If l_NOK Then
				l_Err = -2
				Exit For
			End If			
		Next i
	End If

	'process
	If (l_Err = 0) Then
		'On Local Error Goto ErrHandler
		'get the range data array
		l_RangeArray = pRange.DataArray
		'update the data array
		For i = 0 To UBound(l_RangeArray) - 1
			l_Lookup = l_RangeArray(i)(pLookupIndex - 1)
			If (l_Lookup = pSearch) Then
				For j = 0 To UBound(pUpdateValues)
					'get the value to insert
					l_Value = pUpdateValues(j)(1)
					'convert into possible data value for storage within a Calc cell
					'(numeric or string)
					l_Value = CalcValue(l_Value)
					'insert
					l_RangeArray(i)(pUpdateValues(j)(0) - 1) = l_Value
				Next j
			End If
		Next i
		'update the data array
		pRange.DataArray = l_RangeArray
	End If

	ErrHandler:
		If Err Then l_Err = Err

	UpdateRangeMultiColumnValuesArray = l_Err
End Function 'UpdateRangeMultiColumnValuesArray