# 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!

edit retag close merge delete

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.

( 2018-12-29 20:27:41 +0100 )edit

What do you mean by "LO color code"?

( 2018-12-30 16:31:05 +0100 )edit

Sort by » oldest newest most voted

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 - C:\fakepath\Skin colors.ods

more

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.

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!"

more

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.

more

C:\fakepath\ral to rgb test.ods

Windows 10 LibreOffice 6.2.8.2

Any idea about the error above?

more

Strange error. How do you call this function?

( 2020-08-25 15:53:55 +0100 )edit

=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

( 2020-08-25 16:09:06 +0100 )edit

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.

( 2020-08-25 17:58:07 +0100 )edit

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. :(

( 2020-08-26 11:19:34 +0100 )edit

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.

( 2020-08-26 11:28:11 +0100 )edit

Column H calls the function

Module 14 contains the function

( 2020-08-26 11:47:09 +0100 )edit

2. For communication use the comments.
3. To add information / clarification edit the question.

This helps keeps the site usable for everyone. Thanks.

( 2020-08-26 11:58:27 +0100 )edit

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

( 2020-08-26 12:24:05 +0100 )edit

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

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. C:\fakepath\ral to rgb test edited not excel.ods

( 2020-08-26 18:11:29 +0100 )edit

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

( 2020-08-27 09:53:28 +0100 )edit