Ask Your Question
1

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?

asked 2018-12-29 20:06:58 +0200

spockface gravatar image

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 flag offensive close merge delete

Comments

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.

JohnSUN gravatar imageJohnSUN ( 2018-12-29 20:27:41 +0200 )edit

What do you mean by "LO color code"?

Lupp gravatar imageLupp ( 2018-12-30 16:31:05 +0200 )edit

4 Answers

Sort by » oldest newest most voted
0

answered 2018-12-29 21:34:37 +0200

JohnSUN gravatar image

updated 2020-11-26 14:09:43 +0200

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

ColorsDemo.png

edit flag offensive delete link more
1

answered 2020-08-25 17:27:59 +0200

igorlius gravatar image

updated 2020-08-25 18:53:38 +0200

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.: https://wiki.openoffice.org/wiki/Docu...

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: image description

Sheet1 where BG color is set: image description

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

edit flag offensive delete link more
1

answered 2018-12-30 00:14:45 +0200

Lupp gravatar image

updated 2018-12-30 14:00:06 +0200

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.

edit flag offensive delete link more
0

answered 2020-08-25 15:45:06 +0200

pauloams95 gravatar image

updated 2020-08-26 11:45:07 +0200

image description

C:\fakepath\ral to rgb test.ods

Windows 10 LibreOffice 6.2.8.2

Any idea about the error above?

edit flag offensive delete link more

Comments

Strange error. How do you call this function?

JohnSUN gravatar imageJohnSUN ( 2020-08-25 15:53:55 +0200 )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

pauloams95 gravatar imagepauloams95 ( 2020-08-25 16:09:06 +0200 )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.

JohnSUN gravatar imageJohnSUN ( 2020-08-25 17:58:07 +0200 )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. :(

pauloams95 gravatar imagepauloams95 ( 2020-08-26 11:19:34 +0200 )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.

JohnSUN gravatar imageJohnSUN ( 2020-08-26 11:28:11 +0200 )edit

Column H calls the function

Module 14 contains the function

pauloams95 gravatar imagepauloams95 ( 2020-08-26 11:47:09 +0200 )edit

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.

igorlius gravatar imageigorlius ( 2020-08-26 11:58:27 +0200 )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.

JohnSUN gravatar imageJohnSUN ( 2020-08-26 12:24:05 +0200 )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

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

JohnSUN gravatar imageJohnSUN ( 2020-08-26 18:11:29 +0200 )edit

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

pauloams95 gravatar imagepauloams95 ( 2020-08-27 09:53:28 +0200 )edit
Login/Signup to Answer

Question Tools

3 followers

Stats

Asked: 2018-12-29 20:06:58 +0200

Seen: 1,485 times

Last updated: Nov 26 '20