A macro for setting the background color of a cell based on its contents

[RobertGP17]

Hi,

Need help creating a macro that searches for specified text in a document and sets a specified cell background color if found.

Example: column K contains ambulance call totals, in some documents some totals may not exist, it’s always different, that’s the problem.

My macro is quite simple and clumsy, if it doesn’t find the right total it sets the background color of the cell of the previous found total.

Here is an example of my macro, it only has three totals, but in reality there are many more.

    sub BColor
	
	dim document as object
    dim dispatcher as object

    document = ThisComponent.CurrentController.Frame
    dispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
	
dim color1Args(1) as new com.sun.star.beans.PropertyValue
color1Args(0).Name = "SearchItem.SearchString"
color1Args(0).Value = "Hospitalized"
color1Args(1).Name = "SearchItem.Command"
color1Args(1).Value = 1
dispatcher.executeDispatch(document, ".uno:ExecuteSearch", "", 0, color1Args())

dim colorBk1Args(0) as new com.sun.star.beans.PropertyValue
colorBk1Args(0).Name = "BackgroundColor"
colorBk1Args(0).Value = 16768601
dispatcher.executeDispatch(document, ".uno:BackgroundColor", "", 0, colorBk1Args())

dim color2Args(1) as new com.sun.star.beans.PropertyValue
color2Args(0).Name = "SearchItem.SearchString"
color2Args(0).Value = "NO ON THE PLACE"
color2Args(1).Name = "SearchItem.Command"
color2Args(1).Value = 1
dispatcher.executeDispatch(document, ".uno:ExecuteSearch", "", 0, color2Args())

dim colorBk2Args(0) as new com.sun.star.beans.PropertyValue
colorBk2Args(0).Name = "BackgroundColor"
colorBk2Args(0).Value = 15658734
dispatcher.executeDispatch(document, ".uno:BackgroundColor", "", 0, colorBk2Args())

dim color3Args(1) as new com.sun.star.beans.PropertyValue
color3Args(0).Name = "SearchItem.SearchString"
color3Args(0).Value = "Call canceled*"
color3Args(1).Name = "SearchItem.Command"
color3Args(1).Value = 1
dispatcher.executeDispatch(document, ".uno:ExecuteSearch", "", 0, color3Args())

dim colorBk3Args(0) as new com.sun.star.beans.PropertyValue
colorBk3Args(0).Name = "BackgroundColor"
colorBk3Args(0).Value = 16711680
dispatcher.executeDispatch(document, ".uno:BackgroundColor", "", 0, colorBk3Args())

	end sub

Is it possible to make it so that if the desired total is not found, the background color of the cell is not applied and the macro continues to search for another total?

p.s.: I know about such function as Conditional Formatting, but the thing is that each time to create Conditions for new documents is very long, as far as I know the created Conditions are created for one document and they can not be transferred to other documents.

p.s.s: Sorry for the online translator, English is not my primary language, if something is not clear write about it and I will try to rephrase my question.

Thanks

[elmau]

You always mention your working environment, at least version of LibreOffice and SO.

An example file will help anyone who wants to help you.

[RobertGP17]

Got it, I’ll keep it in mind next time, if i ask for help.

[elmau]

Please look if that’s what you want:

Sub Main()
	TEXTS = Array( _
		Array("Hospitalized", 16768601), _
		Array("NO ON THE PLACE", 15658734), _
		Array("Call canceled*", 16711680) _
	)
	sheet = ThisComponent.CurrentController.ActiveSheet
	
	For Each r In TEXTS
		Call set_color(sheet, r(0), r(1))	
	Next
	
End Sub

Sub set_color(sheet, search, color)
	search_in = sheet.getCellRangeByName("A1:E20")
	sd = sheet.createSearchDescriptor()
	sd.setSearchString(search)
	found = search_in.findAll(sd)
	
	If Not IsNull(found) Then
		For Each range In found
			range.CellBackColor = color
		Next
	End If
End Sub

[RobertGP17]

Thank you very much, this solution works for me.