Personal Collection of macros I wrote for LibreOffice (mostly calc)

Functions: macros that can be used as formula

Subroutines: macros intended to be executed after selecting a cell range?

Function CheckXMS ( mCellRange As Object, mCheckCount As Variant, mCheckMinimum As Variant)
' Accumulate Exam marks - counts, minimum
' - used in exam datasheet (XMI)
 
	DIM lRow, uRow, iRow As Integer
	DIM lCol, uCol, iCol As Integer
	DIM cRow, cCol, hVec As Integer
	DIM countValue As Integer
	DIM curValue, minValue, tgtValue As Double
	DIM svcUno As Object 
 
	tgtValue = 0.00
	If NOT IsArray(mCellRange) Then
		CheckXMS = tgtValue & " - Invalid Cell Range?!"
		Exit Function
	End If
 
    svcUno = createUnoService("com.sun.star.sheet.FunctionAccess")
	For hVec = 1 To mCheckCount
	    curValue = svcUno.callFunction("LARGE", Array(mCellRange, hVec))
		If curValue < mCheckMinimum Then
			curValue = mCheckMinimum
		End If
		tgtValue = tgtValue + CurValue
	Next
 
	CheckXMS = tgtValue
 
	'lRow = LBound(mCellRange, 1)
	'uRow = UBound(mCellRange, 1)
	'lCol = LBound(mCellRange, 2)
	'uCol = UBound(mCellRange, 2)
 
	'minValue = 0.00
	'curValue = 0.00
	'go through the cells
	'For iRow = lRow To uRow
	'	For iCol = lCol To uCol
	'		curValue = mCellRange(lRow, iCol)
	'		If curValue < 0.00 Then
	'			curValue = 0.00
	'		End If
	'		If countValue < mCheckCount Or curValue > minValue Then
	'			countValue = countValue + 1
	'			tgtValue = tgtValue - minValue;
	'			tgtValue = tgtValue + curValue;
	'			minValue = curValue
	'		End If
	'	Next
	'Next
 
	'CheckXMS = tgtValue
 
End Function

GetFirst4Char.txt

Sub GetFirst4Char
 
DIM cell AS OBJECT
DIM cells AS OBJECT
DIM sheet AS OBJECT
 
DIM row, col AS INTEGER
DIM msgtext AS STRING
 
cells = ThisComponent.CurrentSelection.RangeAddress
sheet = ThisComponent.CurrentController.ActiveSheet
 
For col = cells.StartColumn To cells.EndColumn
	For row = cells.StartRow To cells.EndRow
		cell = sheet.getCellByPosition(col,row)
		cell.String = Left(cell.String,4)
	Next
Next
 
msgtext = ">> Checked for (" + cells.StartRow + "," + cells.StartColumn + ")"
msgtext = msgtext + " - (" + cells.EndRow + "," + cells.EndColumn + ")"
Msgbox msgtext
 
End Sub

TrimTrailingWS.txt

Sub TrimTrailingWS
 
DIM cell AS OBJECT
DIM cells AS OBJECT
DIM sheet AS OBJECT
 
DIM row, col AS INTEGER
DIM msgtext AS STRING
 
cells = ThisComponent.CurrentSelection.RangeAddress
sheet = ThisComponent.CurrentController.ActiveSheet
 
For col = cells.StartColumn To cells.EndColumn
	For row = cells.StartRow To cells.EndRow
		cell = sheet.getCellByPosition(col,row)
		If Len(cell.String) > Len(Trim(cell.String)) Then
			cell.String = Trim(cell.String)
		End If
	Next
Next
 
msgtext = ">> Checked for (" + cells.StartRow + "," + cells.StartColumn + ")"
msgtext = msgtext + " - (" + cells.EndRow + "," + cells.EndColumn + ")"
Msgbox msgtext
 
End Sub

FillIfNone.txt

Sub FillIfNone
 
DIM ccell AS OBJECT
DIM cell AS OBJECT
DIM cells AS OBJECT
DIM sheet AS OBJECT
 
DIM row, col AS INTEGER
DIM msgtext AS STRING
 
cells = ThisComponent.CurrentSelection.RangeAddress
sheet = ThisComponent.CurrentController.ActiveSheet
 
For col = cells.StartColumn To cells.EndColumn
	For row = cells.StartRow To cells.EndRow
		cell = sheet.getCellByPosition(col,row)
		If cell.String = "" Then
			ccell = sheet.getCellByPosition(col-1,row)
			If cCell.Value < 0.00 Then
				cell.Value = ccell.Value
			Else
				cell.Value = -1.00
			End If
		End If
	Next
Next
 
msgtext = ">> Checked for (" + cells.StartRow + "," + cells.StartColumn + ")"
msgtext = msgtext + " - (" + cells.EndRow + "," + cells.EndColumn + ")"
Msgbox msgtext
 
End Sub

AddLeadingZero.txt

Sub AddLeadingZero
 
DIM document AS OBJECT
DIM sheet AS OBJECT
DIM cell  AS OBJECT
DIM cells  AS OBJECT
DIM cellrange AS OBJECT
 
DIM row, col AS INTEGER
DIM msgtext AS STRING
 
document = ThisComponent
sheet = document.CurrentController.ActiveSheet
cells = document.CurrentSelection
 
'cellrange = cells.CellAddress 'only works for single cell selection?
'cellrange.Row '0-base index
'cellrange.Col '0-base index
'Msgbox ">> (" + cellrange.Row + "," + cellrange.Column + ")"
 
cellrange = cells.RangeAddress
'msgtext = ">> (" + cellrange.StartRow + "," + cellrange.StartColumn + ")"
'msgtext = msgtext + " - (" + cellrange.EndRow + "," + cellrange.EndColumn + ")"
'Msgbox msgtext
 
For col = cellrange.StartColumn To cellrange.EndColumn
	For row = cellrange.StartRow To cellrange.EndRow
		cell = sheet.getCellByPosition(col,row)
		While Len(cell.String) < 9
			cell.String = "0" + cell.String
		Wend
	Next
Next
 
msgtext = ">> Added for (" + cellrange.StartRow + "," + cellrange.StartColumn + ")"
msgtext = msgtext + " - (" + cellrange.EndRow + "," + cellrange.EndColumn + ")"
Msgbox msgtext
 
End Sub