BASIC runtime error. Sub-procedure or function procedure not defined - macros

What I'm trying to do is to count the average of some cells on the Macro of LibreOffice Calc...
By this code:
REM ***** BASIC *****
Private Sub myrange()
myrange = Range("G31:G42")
Range("H45") = WorksheetFunction.Average(myrange)
End Sub
I got the error:
BASIC runtime error.
Sub-procedure or function procedure not defined.
What should I do?

If you try to average the cells G31:G42 and insert the result in cell H45 then the following macro may helps you:
Private Sub myrange()
Dim Doc, myrange, sheet As Object
Doc = ThisComponent
sheet = Doc.Sheets(0)
sheet.getCellRangeByName("H45").Formula = "= AVERAGE(G31:G42)"
End Sub

Related

In LibreOffice Calc, how do I change through LibreOffice Basic the value of a cell with an event listener set to it without crashing the program?

I am trying to create two tables which mirror changes made to any of them to one another automatically.
To that end, I added event listeners which are triggered when the cells of these tables are edited by the user.
Unfortunately, editing one of the tables causes LibreOffice to crash, even though the changes are indeed reflected correctly, as seen upon reopening the file.
I thought the crash might be due to a never-ending circular reference, but it still crashes after it has been made non-circular (by commenting out the relevant parts of the code so that changes are reflected only one way rather than both ways).
I noticed the code worked fine when writing to a cell that didn't have an event listener set to it.
How can I write to one of the cells with event listeners set to them without causing LibreOffice to crash?
You may want to download the following file. Please run Main and then try editing the cell C3 of the Planning sheet. The arbitrary string "C" should be written in the cell C4 of the Services sheet.
Here is a simplified version of the code :
REM ***** BASIC *****
const SERVICESSHEET_NUMBER = 2
const SERVICESSHEET_SERVICES_COLUMN = 2
Type cellStruct
columnNumber As Integer
rowNumber As Integer
End Type
Sub UpdateServicesSheet(editedCell As cellStruct, newValue As String)
Dim oSheets
Dim servicesSheet
oSheets = ThisComponent.getSheets()
servicesSheet = oSheets.getByIndex(SERVICESSHEET_NUMBER)
servicesSheet.getCellByPosition(SERVICESSHEET_SERVICES_COLUMN, 3).setString(newValue)
End Sub
Private oListener, cellRange as Object
Sub AddListener
Dim sheet, cell as Object
sheet = ThisComponent.Sheets.getByIndex(0) 'get leftmost sheet
servicesSheet = ThisComponent.Sheets.getByIndex(2)
cellRange = sheet.getCellrangeByName("C3")
oListener = createUnoListener("Modify_","com.sun.star.util.XModifyListener") 'create a listener
cellRange.addModifyListener(oListener) 'register the listener
cellRange = servicesSheet.getCellrangeByName("C4")
oListener = createUnoListener("Modify_","com.sun.star.util.XModifyListener") 'create a listener
cellRange.addModifyListener(oListener) 'register the listener
End Sub
global CircularReferenceAllowed As boolean
Sub Modify_modified(oEv)
Dim editedCell As cellStruct
Dim newValue As String
editedCell.columnNumber = 2
editedCell.rowNumber = 2
If CircularReferenceAllowed Then
CircularReferenceAllowed = false
UpdateServicesSheet(editedCell, "C")
End If
End Sub
Sub Modify_disposing(oEv)
End Sub
Sub RmvListener
cellRange.removeModifyListener(oListener)
End Sub
Sub Main
CircularReferenceAllowed = true
AddListener
End Sub
Crossposted to :
OpenOffice forums
LibreOffice discourse platform
It seems like the event trigger is within another event's function is causing the crash. In any case, the solution is to remove the listener, then add it back after modifying the other cell.
You do need to global the Listener and the Cell objects to make this work.
This code is simplified to work on C3 and C15 on the first sheet. It would also output some information on C14, which isn't really necessary for your purpose, but I use it to see what's happening. You need to adopt the according to what you need.
global goListener as Object
global goListener2 as Object
global goCellR as Object
global goCellR2 as Object
global goSheet as Object
global giRun as integer
global giUpd as Integer
Sub Modify_modified(oEv)
Dim sCurStr$
Dim sNewStr As String
'xRay oEv
giRun = giRun + 1
sCurStr = oEv.source.string
oCell = goSheet.getCellByPosition(2, 14)
If (oCell.getString() <> sCurStr) Then
' only update if it's different.
giUpd = giUpd + 1
goCellR2.removeModifyListener(goListener2)
oCell.setString(sCurStr)
goCellR2.addModifyListener(goListener2)
End If
sNewStr =sCurStr & " M1 Run=" & giRun & " Upd=" & giUpd
goSheet.getCellByPosition(2, 13).setString(sNewStr)
End Sub
Sub Modify2_modified(oEv)
Dim sCurStr$
Dim sNewStr As String
Dim oCell as Object
'xRay oEv
giRun = giRun + 1
sCurStr = oEv.source.string
oCell = goSheet.getCellByPosition(2, 2)
If (oCell.getString() <> sCurStr) Then
' only update if it's different.
giUpd = giUpd + 1
goCellR.removeModifyListener(goListener)
oCell.setString(sCurStr)
goCellR.addModifyListener(goListener)
End If
sNewStr =sCurStr & " M2 Run=" & giRun & " Upd=" & giUpd
goSheet.getCellByPosition(2, 13).setString(sNewStr)
End Sub
Sub Modify_disposing(oEv)
MsgBox "In Modify_disposing"
End Sub
Sub Modify2_disposing(oEv)
MsgBox "In Modify2_disposing"
End Sub
Sub RmvListener
MsgBox "In RmvListener"
goCellR.removeModifyListener(goListener)
goCellR2.removeModifyListener(goListener2)
End Sub
Sub AddListener
goSheet = ThisComponent.Sheets.getByIndex(0) 'get leftmost goSheet
'servicesSheet = ThisComponent.Sheets.getByIndex(2)
goCellR = goSheet.getCellrangeByName("C3")
goListener = createUnoListener("Modify_","com.sun.star.util.XModifyListener") 'create a listener
goCellR.addModifyListener(goListener) 'register the listener
goCellR2 = goSheet.getCellrangeByName("C15")
goListener2 = createUnoListener("Modify2_","com.sun.star.util.XModifyListener") 'create a listener
goCellR2.addModifyListener(goListener2) 'register the listener
End Sub
Sub Main
giRun = 0
giUpd = 0
AddListener
End Sub

how to pass cellrange to a user defined macro paramenter

i would like to work with cellranges within my macro.
Function SumIfColor(SumRange)
Dim oRange as object
Dim oSheet as object
' Get Access to the Active Spreadsheet
oSheet = ThisComponent.CurrentController.ActiveSheet
' Get access to the Range listed in Sum Range
oRange = oSheet.getCellRangeByName(SumRange).RangeAddress
End Function
The question is how can I call this function with real cellRange object instead of String. Because getCellRangeByName works only with String variable.
Because when I call the function like this
sumifcolor(B1:B3)
I got the following error:
"Object variable not set"
I read some hint here but it did not helped me.
It is not possible to pass an actual CellRange object. One solution is to pass the row and column number, similar to the second part of #Axel Richter's answer in the link:
Function SumIfColor(lcol1, lrow1, lcol2, lrow2)
sum = 0
oCellRange = ThisComponent.CurrentController.ActiveSheet.getCellRangeByPosition(_
lcol1-1,lrow1-1,lcol2-1,lrow2-1)
For lCol = 0 To oCellRange.Columns.Count -1
For lRow = 0 To oCellRange.Rows.Count -1
oCell = oCellRange.getCellByPosition(lCol, lRow)
If oCell.CellBackColor > -1 Then
sum = sum + oCell.Value
End If
Next
Next
SumIfColor = sum
End Function
To call it:
=SUMIFCOLOR(COLUMN(B1:B3),ROW(B1),COLUMN(B3),ROW(B3))
The sum will be recalculated whenever a value in the range B1:B3 is changed, because of COLUMN(B1:B3). However, apparently changing only the color of a cell does not cause it to be recalculated.

How to end a Basic function properly

I'm trying to write a function in Basic for LibreOffice Calc to get the first letter of each word of the selected cell using the following code:
Function GetFirstLetters(rng) As String
Dim arr
Dim I As Long
arr = Split(rng, " ")
If IsArray(arr) Then
For I = LBound(arr) To UBound(arr)
GetFirstLetters = GetFirstLetters & Left(arr(I), 1)
Next I
Else
GetFirstLetters = Left(arr, 1)
End If
End Function
And it works correctly, unless I try to execute it again, then it seems that the new result gets appended to that of any previous execution and it will return both strings together, example:
It also doesn't matter if I delete some or even all cells, or if I call it using an empty cell or even in another page, it will always append the result to the previous one:
Why does this happen? How can I fix this behaviour?
I don't know anything about Basic, so please don't bash on me if this is something very simple.
The original function is this:
Function GetFirstLetters(rng As Range) As String
'Update 20140325
Dim arr
Dim I As Long
arr = VBA.Split(rng, " ")
If IsArray(arr) Then
For I = LBound(arr) To UBound(arr)
GetFirstLetters = GetFirstLetters & Left(arr(I), 1)
Next I
Else
GetFirstLetters = Left(arr, 1)
End If
End Function
And I got it from here: http://www.extendoffice.com/documents/excel/1580-excel-extract-first-letter-of-each-word.html.
The code you have found is VBA for Excel. Openoffice or Libreoffice uses StarBasic, not VBA. This is similar but not equal. So you can't simply use the same code as in Excel.
First difference is, there is no Range object. This you have noticed and have used rng as an Variant.
But another difference is, function names are like variable names in the global scope. And they will not be reseted if the function is called again. So in StarBasic we better do:
Function GetFirstLetters(sCellValue as String) As String
Dim arr As Variant
Dim I As Long
Dim sResult As String
arr = Split(sCellValue, " ")
If IsArray(arr) Then
For I = LBound(arr) To UBound(arr)
sResult = sResult & Left(arr(I), 1)
Next I
Else
sResult = Left(arr, 1)
End If
GetFirstLetters = sResult
End Function
sResult is reseted (new Dimed) every time the function is called. So even the function's return value.

convert simple VB script to MATLAB

I have some problem converting simples VB scripts (formating) into MATLAB:
VB script:
Range("A1").Select
Selection.Font.Italic = True
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
End With
I tried:
xlswrite('test.xls',1,'A1');
Excel = actxserver('Excel.Application');
Excel.Workbooks.Open('test.xls');
Range = Excel.Range('A1');
Range.Font.Italic = True; % Doesnt work
Range.Border.Item('xlEdgeRight').LineStyle = 1; % Doesnt work
Excel.Visible = 1;
Any workaround? Thanks
The problem is probably this line:
Range = Excel.Range('A1');
Your Excel object is an Application object, which doesn't have a Range property. The VBA example you follow uses a (IMHO) poor practice of using the global default objects that are only available within the context of the application itself. You need to grab a reference to the Workbook returned by this call:
Excel.Workbooks.Open('test.xls');
After that, you need to get the worksheet from it's indexed Worksheets property, then get the Range from that. Also, "xlEdgeRight" is an enumeration member so external calls have to use the integer values for them instead of a string. You can replace xlEdgeRight with 10.
I know next to nothing about Matlab, but this is what the more explicit code would look like in VBA:
Dim book As Workbook, sheet As Worksheet, rng As Range
Set book = Application.Workbooks.Open("test.xls")
Set sheet = book.Worksheets("Sheet1")
Set rng = sheet.Range("A1")
rng.Font.Italic = True
rng.Borders.Item(10).LineStyle = 1
You should be able to get it from there.

vba error 438 but object class does contain sub

I am writing code which is supposed to read in data from an Excel worksheet, save it as strings into variables contained in an object of a class which I have defined and then add this object to an object tree of a class which I have also defined.
Dim ProdTreeMain As New CProdTree
Dim nR As Range
Dim nnR As Range
Set nR = oXS.Range("A1")
Set nnR = oXS.Range("A1")
dim r as integer
r = 1
Do While Not (nR.Text = "" And nnR.Text = "")
If CONDITION IS TRUE:
Dim currProd As New CProduct
ProdTreeMain.addProduct (currProd) '<-- error 438 "Object doesn't support property or method
End If
r = r + 1
Set nR = oXS.Range("A" & CStr(r + 1))
Set nR = oXS.Range("A" & CStr(r + 2))
Loop
The class CProdTree contains a sub "addProduct" which takes an input object of class CProduct by reference.
Public Sub addProduct(ByRef Prod As CProduct)
What the hell is going on? The class is defined, the sub correct, the variable type being passed to the sub is of the correct class and yet I get this error ... :/
You need to drop the parentheses around the argument. My favorite explanation is this Daily Dose of Excel post.
This line:
ProdTreeMain.addProduct (currProd)
becomes:
ProdTreeMain.addProduct currProd