Change cell background color with mouse click

[cybersurfer5000]

Hello.

I would like to change the cell background color of the calender days J3:U33 (image below) via a mouse click. The cell should change to 3 different colors if you keep clicking that cell.

Below macro from JohnSUN (link to his post and example file) is great! and does change the cell’s background color.

Option Explicit
Option Base 0

Public oMouseClickHandler	

Sub RegisterMouseClickHandler
   oMouseClickHandler =  createUnoListener("MouseOnClick_", "com.sun.star.awt.XMouseClickHandler")
   ThisComponent.getCurrentController().addMouseClickHandler(oMouseClickHandler)
   cntClick(-1)
End Sub

Sub UnregisterMouseClickHandler
	On Error Resume Next
	ThisComponent.getCurrentController().removeMouseClickHandler(oMouseClickHandler)
	On Error GOTO 0
End Sub

Sub MouseOnClick_disposing(oEvt)
End Sub

Function MouseOnClick_mousePressed(oEvt) As Boolean
	MouseOnClick_mousePressed = False
End Function


Function MouseOnClick_mouseReleased(oEvt) As Boolean
Dim oCell As Object
Dim oSheet As Object
Dim nColumn%, nRow%
Dim tmp
Dim colors

	MouseOnClick_mouseReleased = False
	colors = Array(RGB(119,188,101), RGB(255,109,109), RGB(221,221,221), RGB(221,221,221))
	oCell = ThisComponent.getCurrentSelection()
	If oCell.getImplementationName() <> "ScCellObj" Then Exit Function
	oSheet = oCell.getSpreadsheet()

	nColumn = oCell.getCellAddress().Column
	nRow = oCell.getCellAddress().Row
	
	    
    If (nColumn < 5) AND (nRow < 5) Then
    		oCell.CellBackColor = colors(Int((cntClick())/5) MOD UBound(colors))
    	ElseIf (nColumn = 5) AND (nRow = 5) Then
    		tmp =  oCell.LeftBorder
    		On Error Resume Next
    		tmp.InnerLineWidth = 50 
    		tmp.LineWidth = 40
    		On Error GOTO 0
    		For nColumn = 0 To 4
    			For nRow = 0 To 4
    				oCell = oSheet.getCellByPosition(nColumn, nRow)
    				tmp.Color = oCell.CellBackColor
    				oCell.clearContents(1023)
    				If tmp.Color > -1 Then
    					oCell.LeftBorder = tmp
    					oCell.BottomBorder = tmp
    					oCell.RightBorder = tmp
    					oCell.TopBorder = tmp
    				EndIf
    			Next nRow
    		Next nColumn
    		cntClick(-1)
    	EndIf
    End Function
Function cntClick(Optional newValue%) As Long
Dim oNamedRanges As Object
Dim oNamedRange As Object
Dim sContent As String
Dim iRes%
Const varName = "cntClick"
	oNamedRanges = ThisComponent.NamedRanges
	If not oNamedRanges.hasByName(varName) Then oNamedRanges.addNewByName(varName, _
		"-1",createUNOStruct("com.sun.star.table.CellAddress"),0)
	oNamedRange = oNamedRanges.getByName(varName)
	If IsMissing(newValue) Then
		sContent = oNamedRange.getContent()
		iRes = Val(sContent)+1
		oNamedRange.setContent("" & iRes)
		cntClick = iRes
	Else
		oNamedRange.setContent("" & newValue)
		cntClick = newValue
	End If
End Function

QUESTION:
However, I need to edit the code (I am a total noob when it comes to macros), so that it applies to cells J3:U33 (in his example, it applies to A1:E5 → “red circle” in image below). Does anyone know how to edit the row thats circled red, or has an alternative solution to change the background color via a mouse click?

I know it is a monster of a post for a question like this, but a wanted to make sure I explain myself correctly.

Thank you
Sophie

[EarnestAl]

Hi. JohnSun has commented his code but in Russian so suggested people use Google translate to read the comments. These comments are likely to help you to answer your question, e.g.

	If (nColumn < 5) AND (nRow < 5) Then	' This is area A1: E5
REM And now cntClick () will increase the click count by one and return that number

Rem and ’ are comments and don’t form part of the code

[JohnSUN]

Oh Sophie, this is too long code - hard to read and hard to edit. For your task, the macro code is much shorter:

Function onDblClick(oEvent As Variant) As Boolean
Const RANGE_TO_COLORIZE = "J3:U33"	' Set a range address that will respond to double clicks '
Dim colors As Variant
Dim i As Integer
	onDblClick = False
	If oEvent.getSpreadsheet().getCellRangeByName(RANGE_TO_COLORIZE).queryIntersection(oEvent.getRangeAddress()).getCount() Then 
		onDblClick = True
		colors = Array(-1, RGB(255,0,0), RGB(0,255,0), RGB(0,0,255)) ' -1 is "default color" (white), set values to other '
		For i = LBound(colors) To UBound(colors)
			If oEvent.CellBackColor = colors(i) Then
				oEvent.CellBackColor = colors((i + 1) Mod 4)	' Current color found, set next '
				Exit Function
			EndIf 
		Next i
		oEvent.CellBackColor = colors(0)	' Current color not found and not default, set default '
	EndIf 
End Function

Just assign this function to handle the desired event

Demo - ColorDblClick.ods

[cybersurfer5000]

Wonderful! THANK YOU @JohnSUN