Because it is very useful to me, I continue to explore my little code snippet here. The establishment of checkboxes becomes very simple since it is obviously a simple copy and paste. For the sake of simplicity, I have just produced a new version that changes the module’s name from “Module1” to “checkBoxes”. This simplifies the setup in other files (and copy/paste checkboxes too).
But above all...
As I am using this thing quite intensely, I have also been able to test its limits. And the first of them is the exclusive use of the mouse. So I said that it would be nice if we can check or uncheck the boxes with the keyboard, for example with the spacebar. For this, a listener type KeyHandler is obviously necessary. I had never played this game, but it is well documented to be no problem.
The goal of the game is to listen the spacebar and, if the selected cell contains a formula with a HYPERLINK function, typical of the checkboxes, make sure that the edition is diverted to:
- Reconstitute the URL that contains the function.
- Call the correct procedure, checkBox() or radioButton().
It is quite different for the radio buttons which, in addition to communicating the location of the clicked button, obviously also give the range of cells in which they act. And as I still want the copy/paste is done very easily, I use ADDRESS, ROW and COLUMNS functions.
To recover the formula of a cell is obviously very simple. But part of its result is much more complicated... Here, what I want to recover is the result of the URL passed to HYPERLINK. I would need a function of the type “EVAL” ... that I did not find. I'm coming out of this pitfall by:
- Taking the complete formula HYPERLINK as a string of characters.
- Eliminating his head and tail ...
- Putting this in an empty cell of the spreadsheet, which causes its interpretation.
- Recovering, finally, the result.
- Cleaning the cell of its contents immediately.
We go to the cell with the arrow keys, we press on the spacebar for switches the control in hyperlink form. Set up 500 checkboxes in a column take few seconds. The incremental validation in check or uncheck with the arrow keys and the space bar is ecstasy that no normal control allows... Even the most reluctant to use the spreadsheet cannot fail to admit this obvious...
While I'm very happy that this set works perfectly, even if the spreadsheet is protected, the final cleaning of the cell does not work if the sheet is protected. We are therefore obliged, for the empty cell with temporary content, to hide its contents.
BUT, in any case, it remains that the reading/analysis of the HYPERLINK URL is a pure shame of programming.
Would some of you have ideas for more elegance? I have seen quoted a thousand times the link “www.oooforum.org/forum/viewtopic.phtml?t=58809” ; but we know all that the oooforum.org is dead and buried. Same I know that JavaScript has an eval function; but you understand that JavaScript do not know the functions of Calc...
Code: Select all
Private myKeyHandler As Object
Const emptyCellForEval = "$A$1"
Const myFormula_0 = "vnd.sun.star.script:Standard.checkBoxes."
Const myFormula_1 = "?language=Basic&location=document"
' ╔══════════════════════════════════════════════════════════════════════════════════╗
' ║ Listener for check or uncheck a checkbox or a radio button with the space bar. ║█
' ╚══════════════════════════════════════════════════════════════════════════════════╝█
' ▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀
Sub addKeyHandler
myKeyHandler = createUnoListener("KeyHandler_", "com.sun.star.awt.XKeyHandler")
thisComponent.currentController.addKeyHandler(myKeyHandler)
End Sub
Sub KeyHandler_disposing : End Sub
Sub removeKeyHandler
thisComponent.currentController.removeKeyHandler(myKeyHandler)
End Sub
Function KeyHandler_keyPressed(myKeyEvent As New com.sun.star.awt.KeyHandler) As Boolean
Dim myFunction As Object
Dim myFormula As String, myAddressCell As String, myType As String, myURL As String
KeyHandler_keyPressed = False
' Just ONE cell must be selected.
If not thisComponent.currentSelection.supportsService("com.sun.star.sheet.SheetCell") Then Exit Function
myFunction = createUnoService("com.sun.star.sheet.FunctionAccess")
myFormula = thisComponent.currentSelection.formula
If myKeyEvent.keyCode = com.sun.star.awt.Key.SPACE Then
If inStr(myFormula, myFormula_0 & "checkBox" & myFormula_1) > 0 Or _
inStr(myFormula, myFormula_0 & "radioButton" & myFormula_1) > 0 Then
KeyHandler_keyPressed = True
Select Case inStr(myFormula, "checkBox?")
Case > 0 ' Cell with checkbox.
With thisComponent.currentSelection.cellAddress
myAddressCell = myFunction.callFunction("ADDRESS", Array((.row + 1), (.column + 1), 1))
End With
myType = left(getArgumentFromURL(myFormula, "myType"), 1) ' A bit coded with my feets...
myURL = myFormula_0 & "checkBox" & myFormula_1 & "&myCell=" & myAddressCell & "&myType=" & myType
checkBox(myURL)
Case 0 ' Cell with radio button.
mid(myFormula, 2, 9) = "" ' Delete the word HYPERLINK at start.
mid(myFormula, len(myFormula) - 5, 5) = "" ' Delete the chars ; "" or ; "" at end.
With thisComponent.currentController.activeSheet.getCellRangeByName(emptyCellForEval)
.formula = myFormula ' Place the new formula in an empty cell.
myURL = .string ' It is evaluated and saved right away.
.string = "" ' Cleanup.
End With
radioButton(myURL)
End Select
End If
End If
End Function
Function KeyHandler_keyReleased(myKeyEvent As New com.sun.star.awt.KeyHandler) As Boolean
KeyHandler_keyReleased = False
End Function
' ╔══════════════════════════════════════════════════════════════════════════════════╗
' ║ Checkoxes management. ║█
' ╚══════════════════════════════════════════════════════════════════════════════════╝█
' ▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀
Sub checkBox(myURL As String)
Dim mySheet As Object, myCell As Object
Dim myCheck(1) As String, myFormula As String
Select Case cInt(getArgumentFromURL(myURL, "myType"))
Case 0 : myCheck(0) = "☐" : myCheck(1) = "☒"
Case 1 : myCheck(0) = "☐" : myCheck(1) = "☑"
Case 2 : myCheck(0) = "◄" : myCheck(1) = "►"
Case 3 : myCheck(0) = "M" : myCheck(1) = "F"
End Select
mySheet = thisComponent.currentController.activeSheet
myCell = mySheet.getCellRangeByName(getArgumentFromURL(myURL, "myCell"))
myFormula = myCell.formula
If mid(myFormula, (len(myFormula) - 2), 1) = myCheck(0) Then ' Mid is here a FUNCTION.
mid(myFormula, (len(myFormula) - 2), 1) = myCheck(1) ' Mid is here an INSTRUCTION.
Else
mid(myFormula, (len(myFormula) - 2), 1) = myCheck(0) ' Mid is here an INSTRUCTION.
End If
myCell.formula = myFormula
End Sub
' ╔══════════════════════════════════════════════════════════════════════════════════╗
' ║ Radio buttons management. ║█
' ╚══════════════════════════════════════════════════════════════════════════════════╝█
' ▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀
Sub radioButton(myURL As String)
Dim mySheet As Object, myCell1 As Object, myCell2 As Object, myGroup As Object
Dim myRadio(1) As String, myFormula As String
Dim i As Integer
Select Case cInt(getArgumentFromURL(myURL, "myType"))
' Unchecked Checked BE CAREFUL : the character font is WINGDINGS (not UTF8).
Case 0 : myRadio(0) = chr(61601) : myRadio(1) = chr(61604) ' U+F0A1 and U+F0A4
' Imagine here other sort of radio buttons...
End Select
mySheet = thisComponent.currentController.activeSheet
myGroup = mySheet.getCellRangeByName(getArgumentFromURL(myURL, "myGroup")).rangeAddress
myCell1 = mySheet.getCellRangeByName(getArgumentFromURL(myURL, "myCell" )).rangeAddress
With myGroup
For i = .startColumn To .endColumn
myCell2 = mySheet.getCellByPosition(i, .startRow)
myFormula = myCell2.formula
If i = myCell1.startColumn Then
mid(myFormula, (len(myFormula) - 2), 1) = myRadio(1) ' Mid is here an INSTRUCTION.
Else
mid(myFormula, (len(myFormula) - 2), 1) = myRadio(0) ' Mid is here an INSTRUCTION.
End If
myCell2.formula = myFormula
Next i
End With
End Sub
' ╔══════════════════════════════════════════════════════════════════════════════════╗
' ║ Extracts the values of variables (text) passed in argument with the URL call. ║█
' ╚══════════════════════════════════════════════════════════════════════════════════╝█
' ▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀
Function getArgumentFromURL(sURL$, sName$) As String
On Error Goto exitErr:
Dim iStart%, i%, l%, sArgs$, a()
iStart = instr(sURL, "?")
l = len(sName)
If (iStart = 0) or (l = 0) Then Exit Function
sArgs = mid(sURL, iStart + 1) ' sArgs behind "?".
a() = split(sArgs, "&")
For i = 0 To uBound(a())
If instr(1, a(i), sName & "=", 1) = 1 Then ' Not case sensitive.
getArgumentFromURL = Mid(a(i), l + 2)
Exit for
Endif
Next i
exitErr: ' Return "".
End Function
' ╔══════════════════════════════════════════════════════════════════════════════════╗
' ║ Just a little demonstration for say that the help is not always absolutely true. ║█
' ║ ║█
' ║ The help say: "Tips are always enabled." ║█
' ║ https://help.libreoffice.org/Common/Tips_and_Extended_Tips ║█
' ╚══════════════════════════════════════════════════════════════════════════════════╝█
' ▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀
Sub swichDisplayHelpTip()
Dim oDisp As Object
oDisp = createUnoService("com.sun.star.frame.DispatchHelper")
oDisp.executeDispatch(ThisComponent.CurrentController.Frame, ".uno:HelpTip", "", 0, array())
End Sub