BASIC: Problem on using VBASupport 1

English
,
#1

VBASupport1b.ods is the original file.
I added Option VBASupport 1, used Round function and saved as VBASupport1a.ods.

After running Sub TransferValueContentFromCellToGrid on VBASupport1a.ods, I got an error message:

BASIC syntax error.
Expected: =.

What is wrong in line 9 ?
VBASupport1a.ods (128.5 KB)
VBASupport1b.ods (13.1 KB)
LibreOffice:
Version: 7.3.4.2 / LibreOffice Community
Build ID: 30(Build:2)
CPU threads: 4; OS: Linux 5.15; UI render: default; VCL: gtk3
Locale: en-US (en_US.UTF-8); UI: en-US
Ubuntu package version: 1:7.3.4-0ubuntu0.22.04.1
Calc: threaded
OS:
Ubuntu 22.04 LTS

'VBASupport1a.ods
REM  *****  BASIC  *****
Option Explicit
Option VBASupport 1

Sub TransferValueContentFromCellToGrid
	Dim gGrid()
	ReDim gGrid(1 To 1)
	ThisComponent.CurrentController.ActiveSheet.getCellByPosition(0, 0).setValue(3.1459)
	MakeValueContentForGridSaveTemplate(0, 0, "m", gGrid(1), "s")
	gGrid(1) = Round(gGrid(1), 2)
	ThisComponent.CurrentController.ActiveSheet.getCellByPosition(0, 1).setValue(gGrid(1))	
End Sub

Sub MakeValueContentForGridSaveTemplate(pCellPositionColumn&, pCellPositionRow&, pMandatoryOrNonMandatory$, pArrayElement, pIfIncorrectThenExitSubOrStop$)
	Dim JumpToNextRow$ 'x
'	Reset variable : JumpToNextRow
	JumpToNextRow = ""
	Dim oSheet As Object : oSheet = ThisComponent.CurrentController.ActiveSheet
	If UCase(pMandatoryOrNonMandatory) = "MANDATORY" Or UCase(Left(pMandatoryOrNonMandatory,1)) = "M" Then
		Select Case CheckCellContentType(pCellPositionColumn, pCellPositionRow) '[0=EMPTY/BLANK][1=VALUE/DATE][2=TEXT][3=FORMULA]
			Case 1
'				Set cell format to VALUE for sure.	
				ApplyNumberFormatToRange(pCellPositionColumn, pCellPositionRow,pCellPositionColumn, pCellPositionRow, "n")
				pArrayElement = oSheet.getCellByPosition(pCellPositionColumn, pCellPositionRow).String
			Case Else
				If 	UCase(pIfIncorrectThenExitSubOrStop) = "E" Then
					JumpToNextRow = "Y"
					GoTo ExitThisSub		
				End If
				If 	UCase(pIfIncorrectThenExitSubOrStop) = "S" Then 
					Msgbox "Incorrect data in cell >> " & ColumnNameOfColumnIndex(pCellPositionColumn) &  pCellPositionRow + 1, ,"Error"
					Stop
				End If
		End Select

	ElseIf UCase(pMandatoryOrNonMandatory) = "NONMANDATORY" Or UCase(Left(pMandatoryOrNonMandatory,1)) = "N" Then
		Select Case CheckCellContentType(pCellPositionColumn, pCellPositionRow) '[0=EMPTY/BLANK][1=VALUE/DATE][2=TEXT][3=FORMULA]
			Case 0
				pArrayElement = oSheet.getCellByPosition(pCellPositionColumn, pCellPositionRow).String 'Get blank as NULL
			Case 1
'				Set cell format to VALUE for sure.	
				ApplyNumberFormatToRange(pCellPositionColumn, pCellPositionRow, pCellPositionColumn, pCellPositionRow, "v")
				pArrayElement = oSheet.getCellByPosition(pCellPositionColumn, pCellPositionRow).String
			Case 2, 3
				If 	UCase(pIfIncorrectThenExitSubOrStop) = "E" Then
					JumpToNextRow = "Y"
					GoTo ExitThisSub		
				End If
				If 	UCase(pIfIncorrectThenExitSubOrStop) = "S" Then 
					Msgbox "Incorrect data in cell >> " & ColumnNameOfColumnIndex(pCellPositionColumn) &  pCellPositionRow + 1, ,"Error"
					Stop
				End If
		End Select
	End If
ExitThisSub:
End Sub

Function CheckCellContentType%(pColumn&, pRow&)
	Dim oDoc, oSheet, oCell As Object       
	oDoc	= ThisComponent
	oSheet	= oDoc.getcurrentcontroller.activesheet
	oCell	= oSheet.getCellByPosition(pColumn, pRow)
	Select Case oCell.Type
		Case com.sun.star.table.CellContentType.EMPTY	'0
			CheckCellContentType = oCell.Type
		Case com.sun.star.table.CellContentType.VALUE	'1
			CheckCellContentType = oCell.Type
		Case com.sun.star.table.CellContentType.TEXT	'2
			CheckCellContentType = oCell.Type
		Case com.sun.star.table.CellContentType.FORMULA	'3
			CheckCellContentType = oCell.Type
	End Select
End Function

Function ApplyNumberFormatToRange(pStartColumn&, pStartRow&, pEndColumn&, pEndRow&, pDateNumberText$) As Variant
	Dim oFormats	As Object : oFormats = ThisComponent.NumberFormats
	Dim oLocale		As New com.sun.star.lang.Locale
	Dim oRange 		As Object : oRange = ThisComponent.CurrentController.ActiveSheet.getCellRangeByPosition(pStartColumn, pStartRow, pEndColumn, pEndRow)
	If UCase(pDateNumberText) = "D" Then : oRange.NumberFormat = oFormats.getStandardFormat(com.sun.star.util.NumberFormat.DATE, oLocale) 	: End If
	If UCase(pDateNumberText) = "N" Then : oRange.NumberFormat = oFormats.getStandardFormat(com.sun.star.util.NumberFormat.NUMBER, oLocale) : End If
	If UCase(pDateNumberText) = "T" Then : oRange.NumberFormat = oFormats.getStandardFormat(com.sun.star.util.NumberFormat.TEXT, oLocale) 	: End If
End Function

'VBASupport1b.ods
REM  *****  BASIC  *****
Option Explicit
'Option VBASupport 1

Sub TransferValueContentFromCellToGrid
	Dim gGrid()
	ReDim gGrid(1 To 1)
	ThisComponent.CurrentController.ActiveSheet.getCellByPosition(0, 0).setValue(3.1459)
	MakeValueContentForGridSaveTemplate(0, 0, "m", gGrid(1), "s")
'	gGrid(1) = Round(gGrid(1), 2)
	ThisComponent.CurrentController.ActiveSheet.getCellByPosition(0, 1).setValue(gGrid(1))	
End Sub

Sub MakeValueContentForGridSaveTemplate(pCellPositionColumn&, pCellPositionRow&, pMandatoryOrNonMandatory$, pArrayElement, pIfIncorrectThenExitSubOrStop$)
	Dim JumpToNextRow$ 'x
'	Reset variable : JumpToNextRow
	JumpToNextRow = ""
	Dim oSheet As Object : oSheet = ThisComponent.CurrentController.ActiveSheet
	If UCase(pMandatoryOrNonMandatory) = "MANDATORY" Or UCase(Left(pMandatoryOrNonMandatory,1)) = "M" Then
		Select Case CheckCellContentType(pCellPositionColumn, pCellPositionRow) '[0=EMPTY/BLANK][1=VALUE/DATE][2=TEXT][3=FORMULA]
			Case 1
'				Set cell format to VALUE for sure.	
				ApplyNumberFormatToRange(pCellPositionColumn, pCellPositionRow,pCellPositionColumn, pCellPositionRow, "n")
				pArrayElement = oSheet.getCellByPosition(pCellPositionColumn, pCellPositionRow).String
			Case Else
				If 	UCase(pIfIncorrectThenExitSubOrStop) = "E" Then
					JumpToNextRow = "Y"
					GoTo ExitThisSub		
				End If
				If 	UCase(pIfIncorrectThenExitSubOrStop) = "S" Then 
					Msgbox "Incorrect data in cell >> " & ColumnNameOfColumnIndex(pCellPositionColumn) &  pCellPositionRow + 1, ,"Error"
					Stop
				End If
		End Select

	ElseIf UCase(pMandatoryOrNonMandatory) = "NONMANDATORY" Or UCase(Left(pMandatoryOrNonMandatory,1)) = "N" Then
		Select Case CheckCellContentType(pCellPositionColumn, pCellPositionRow) '[0=EMPTY/BLANK][1=VALUE/DATE][2=TEXT][3=FORMULA]
			Case 0
				pArrayElement = oSheet.getCellByPosition(pCellPositionColumn, pCellPositionRow).String 'Get blank as NULL
			Case 1
'				Set cell format to VALUE for sure.	
				ApplyNumberFormatToRange(pCellPositionColumn, pCellPositionRow, pCellPositionColumn, pCellPositionRow, "v")
				pArrayElement = oSheet.getCellByPosition(pCellPositionColumn, pCellPositionRow).String
			Case 2, 3
				If 	UCase(pIfIncorrectThenExitSubOrStop) = "E" Then
					JumpToNextRow = "Y"
					GoTo ExitThisSub		
				End If
				If 	UCase(pIfIncorrectThenExitSubOrStop) = "S" Then 
					Msgbox "Incorrect data in cell >> " & ColumnNameOfColumnIndex(pCellPositionColumn) &  pCellPositionRow + 1, ,"Error"
					Stop
				End If
		End Select
	End If
ExitThisSub:
End Sub

Function CheckCellContentType%(pColumn&, pRow&)
	Dim oDoc, oSheet, oCell As Object       
	oDoc	= ThisComponent
	oSheet	= oDoc.getcurrentcontroller.activesheet
	oCell	= oSheet.getCellByPosition(pColumn, pRow)
	Select Case oCell.Type
		Case com.sun.star.table.CellContentType.EMPTY	'0
			CheckCellContentType = oCell.Type
		Case com.sun.star.table.CellContentType.VALUE	'1
			CheckCellContentType = oCell.Type
		Case com.sun.star.table.CellContentType.TEXT	'2
			CheckCellContentType = oCell.Type
		Case com.sun.star.table.CellContentType.FORMULA	'3
			CheckCellContentType = oCell.Type
	End Select
End Function

Function ApplyNumberFormatToRange(pStartColumn&, pStartRow&, pEndColumn&, pEndRow&, pDateNumberText$) As Variant
	Dim oFormats	As Object : oFormats = ThisComponent.NumberFormats
	Dim oLocale		As New com.sun.star.lang.Locale
	Dim oRange 		As Object : oRange = ThisComponent.CurrentController.ActiveSheet.getCellRangeByPosition(pStartColumn, pStartRow, pEndColumn, pEndRow)
	If UCase(pDateNumberText) = "D" Then : oRange.NumberFormat = oFormats.getStandardFormat(com.sun.star.util.NumberFormat.DATE, oLocale) 	: End If
	If UCase(pDateNumberText) = "N" Then : oRange.NumberFormat = oFormats.getStandardFormat(com.sun.star.util.NumberFormat.NUMBER, oLocale) : End If
	If UCase(pDateNumberText) = "T" Then : oRange.NumberFormat = oFormats.getStandardFormat(com.sun.star.util.NumberFormat.TEXT, oLocale) 	: End If
End Function
#2

In VBA, the syntax for calling subs is different from calling procedures.

You call a sub like this:

MsgBox x

You call a function like this:

x = Len(s)

The parentheses around argument list in a sub call are not allowed in VBA case.

So,

MakeValueContentForGridSaveTemplate 0, 0, "m", gGrid(1), "s"
1 Like
#3

Or put the Call keyword in front of it?

2 Likes
#4

Why VBASupport? This is pure StarBasic.

1 Like
#5

I need to use Round function. That’s why I used Option VBASupport 1 like this.

#6

StarBasic has no Round function? Use the spreadsheet’s function:

Function sbRound(n, d)
	fa = createUnoService("com.sun.star.sheet.FunctionAccess")
	sbRound = fa.callFunction("ROUND",Array(n,d))
End Function
2 Likes
#7

Note to use the latest help available. It also gets constant flow of updates. Note e.g. how the latest article version describes the difference between VBA Round and Calc ROUND.

2 Likes
#8

You can write your own Round function in the StarBasic without the VBA option and without calling the Spreadsheet function ROUND():

REM  *****  BASIC  *****
Function MyRound(TheNumber as double, Decimals as Integer)
 MyRound = Int(TheNumber*10^Decimals)/(10^Decimals)
End function
1 Like
#9

Note that this would round down. Proper rounding is, in fact, hard. I don’t even start with difficulties related to binary-to-decimal inaccuracies.

Note, however, that conversion (both implicit and explicit) to integer types would use rounding using half-from-zero mode. OTOH, note that integer types easily created in Basic are limited to 32-bit Long type; so any doubles outside of Long range would be difficult to round using this. But there are Hyper types in Basic - that one can’t create directly, but can get from UNO structures having such members. I’ll try to create a sample shortly.

2 Likes
#10

This one would be more accurate (again, rounding half-from-zero):

Function MyRound(TheNumber as double, Decimals as Integer)
  TheNumber = TheNumber*10^Decimals
  MyRound = (Fix(TheNumber) + CInt(Frac(TheNumber))) / 10^Decimals
End function

This is based on this:

  1. Fix returns double, so is not limited to any integer type range;
  2. It complements Frac;
  3. Converting the result of the latter to Integer means a result in the range of [-1, 0, +1].

I also considered this:

Function MyRound(TheNumber as double, Decimals as Integer)
  MyRound = createUnoService("com.sun.star.script.Converter").convertToSimpleType(TheNumber*10^Decimals, com.sun.star.uno.TypeClass.HYPER) / 10^Decimals
End function

but the latter will fail for any intermediate value outside of Hyper range (+/-2^63), which would need a fallback On Error code, and anyway, the accuracy of the latter would likely not exceed the accuracy of the former - just because the major loss of the accuracy happens at multiplication/division by a power of 10, that happens in both cases.

4 Likes

Impressum (Legal Info) | Datenschutzerklärung (Privacy Policy)   Content on this site is licensed under a Creative Commons Attribution Share Alike 3.0 license.