In Calc, is there a way to dynamically fill a cell with a color based on a hex code/RGB values/LO color code in an adjacent cell?

I’m trying to create a table of skin colors based on an art project, as part of a workbook meant to randomly generate NPCs for tabletop roleplaying games. I’m hoping there’s some way to take either the hex code, RGB values, or LO color code (the value returned by COLOR[Rvalue,Gvalue,Bvalue,Alpha]) and automatically fill an adjacent cell with that color – I have 200 hex codes in my table, which is a lot to do by hand. I’m familiar with formulas and conditional formatting, but I haven’t been able to figure this one out.

Any help would be much appreciated!

This is not difficult to implement - just create 200 cell styles and use the STYLE() function. Of course, I do not propose to do it manually - this is a boring job, not for an artist. The macro for creating all these styles is not complicated, I am ready to write and show it. But you must help me. Please edit your question and attach a file with samples of color codes that you are going to use. Even creating a test set of such values ​​is boring.

What do you mean by “LO color code”?

You may also play with this attached spreadsheet document (rectified version). It demonstrates ways by direct formatting based on code. You can get an example cell for any RGB value by simply entering it into a cell set to the appropriate named CellStyle.
There is an additional demo using a function. Due to restrictions concerning the side-effects of user functions it can only be called from one sheet with the effect in another sheet.

===Edit1 2018-12-30 12:57 CET===
By accident I fortunately noticed that I had attached a not fully functional version of the demonstrating document. I replaced it with the correct version now.
In addition I now attach this extremely reduced demo to emphasise the principles of the solution using a SheetEvent. The SheetEvent ‘Content changed’ passes a parameter to the handler which is not specified to be of a specific type. It can be a single SheetCell, a single SheetCellRange or a collection of SheetCellRanges (3 different services to use!). A complete handler for the event should therefore contain proceedings for all the probable cases.

Well, you can try this macro:

Function crtStylesIfNeed(sColorCode As String, Optional newStylePrefix As String) As String
Dim oStyleFamilies As Variant, oCellStyles As Variant, oENames As Variant
Dim oBaseCellStyle As Variant, nameParentStyle As String
Dim oNewCellStyle As Variant, nameNewStyle As String, nCellBackColor As Long
	If IsMissing(newStylePrefix) Then newStylePrefix = "c_"
	nameNewStyle = newStylePrefix & sColorCode
	crtStylesIfNeed = nameNewStyle

	oStyleFamilies = ThisComponent.getStyleFamilies()
	oCellStyles = oStyleFamilies.getByName("CellStyles")
	
	If oCellStyles.hasByName(nameNewStyle) Then Exit Function ' Present, nothing to do

	If oCellStyles.hasByName(newStylePrefix) Then
		oBaseCellStyle = oCellStyles.getByName(newStylePrefix)
	Else
		oBaseCellStyle = oCellStyles.getByIndex(0) ' "Default"
	EndIf
	nameParentStyle = oBaseCellStyle.getName()
	
	oNewCellStyle = ThisComponent.createInstance("com.sun.star.style.CellStyle")
	oNewCellStyle.ParentStyle = nameParentStyle
	oCellStyles.insertByName(nameNewStyle, oNewCellStyle)
	nCellBackColor = CLng(Replace(sColorCode,"#","&H"))
	oNewCellStyle.setPropertyValue("CellBackColor", nCellBackColor)
	oNewCellStyle.setPropertyValue("NumberFormat", oBaseCellStyle.NumberFormat)
End Function

Put the formula in the cell and get the result:

=T(STYLE(CRTSTYLESIFNEED(B2;"clr")))

This is spreadsheet with demo of this macro - Skin colors.ods

ColorsDemo.png

image description

ral to rgb test.ods

Windows 10
LibreOffice 6.2.8.2

Any idea about the error above?

Strange error. How do you call this function?

=T(STYLE(CRTSTYLESIFNEED(B2;“clr”)))

what is more strange is that i test this function in one workbook and it runs perfectly.

now i’m trying to apply it on a different workbook and this error appears. the style is applied however the cell doesn’t change

Really weird. What value do you have in cell B2? Try to stop the program at the line that is causing the error using a breakpoint and see with F7 the value of nCellBackColor to see if it matches the color code in B2.

I have the color code in the cell B2. ex. #D0A818

I have done what you suggest in both files (in the one that is working and the one that isn’t working) and the value of nCellBackColor is the same. :frowning:

Please edit your “answer” and attach your problem file - I can’t understand the source of the problem from the verbal description. Also, provide your Operating System and Office version.

Column H calls the function

Module 14 contains the function

Please note:

  1. The answer box is for answers,
  2. For communication use the comments.
  3. To add information / clarification edit the question.

This helps keeps the site usable for everyone.
Thanks.

@pauloams95 Thanks for the sample file. I will try to understand the reason for the error. Please be patient - this will take some time.

Sorry, but I couldn’t find the reason for the error. A little hint was given by the presence of these styles in the file

MSwasHERE.png

There is a myth that Microsoft is so good at hiding sources of errors that even Microsoft cannot find them. And judging by the presence of these styles, the spreadsheet has been in Excel’s clutches.

Therefore, the simplest workaround was to create a new Calc document and transfer data (without formats) and macros to it.
ral to rgb test edited not excel.ods

No problem, thank you for your time.
Probably I will have to transfer the data.

Hello,

here is my try at a solution as a macro function (see end of this post) which can be called via

=SETCOLOR($Sheet1.A3,"Sheet1","B3")
  • the 1st argument is a reference to a cell containing a hex color value (e.g. “ff0000” without the quotes)
  • the 2nd and 3rd argument are strings which specify the cell which shoult be colored

Sadly i found that this solution has one major drawback:

When a macro is called as a Calc
function, the macro cannot modify any
value in the sheet from which the
macro was called.

src.: Accessing cells directly - Apache OpenOffice Wiki

So to use this function, it has to be placed aka. called from a differnt sheet as from the one where you want to change the colors of the cells. If you do that, this works quite nicely.

Sheet2 where the function is called:

Sheet1 where BG color is set:

Here the macro function:

Function SETCOLOR(hexColor as String, dstSheet as String, dstCell)

	dstSheet = Trim(dstSheet)
 	dstCell = Trim(dstCell)

 	Set oActSheet = ThisComponent.CurrentController.ActiveSheet
 	Dim actSheetName As String

	actSheetName = oActSheet.Name
 	
 	REM When a macro is called as a Calc function, the macro cannot modify any value in the sheet from which the macro was called. 
 	REM https://wiki.openoffice.org/wiki/Documentation/OOo3_User_Guides/Calc_Guide/Accessing_cells_directly
 	if ( dstSheet = actSheetName) then
 		SETCOLOR="ERR: macro function can not influence activ sheet"
 		Exit Function
 	endif
	
	Set oDstSheet = ThisComponent.getSheets().getByName(dstSheet)
	Set oDstCell = oDstSheet.getCellRangeByName(dstCell)
	
	REM remove trailing spaces
    hexColor = UCase(Trim(hexColor))

    Dim decColor As Long
	
	REM check length
	if (Len(hexColor) <> 6) then
		SETCOLOR = "ERR: invalid hex code, length <> 6"
		Exit Function
	endif
	
	REM check chars
	For i = 1 To Len(hexColor)
		c = Mid(hexColor, i, 1) 
	    Select Case c
		    Case "0","1","2","3","4","5","6","7","8","9","A","B","C","D","E","F"
		    Case Else
		    SETCOLOR = "ERR: invalid hex code, invalid hex char"
			Exit Function
		End Select
	Next

	decColor = CLng("&H" & hexColor)
    oDstCell.CellBackColor = decColor    
    SETCOLOR = dstSheet & ":" & dstCell & " set to " & hexColor
    
End Function

Maybe it still helps someone.

To show the community your question has been answered, click the ✓ next to the correct answer, and “upvote” by clicking on the ^ arrow of any helpful answers. These are the mechanisms for communicating the quality of the Q&A on this site. Thanks!

Have a nice day and let’s (continue to) “Be excellent to each other!”