Need a MACRO in CALC - apply background color to cell for whole column

LIBREOFFICE CALC MACRO not working.

I’m a complete newbie to macros in CALC BASIC language.

I have one whole column with a colour code in each cell: eg #0F320F (dark green)
my column is K, each cell is a different colour code in Hexadecimal.
(I do have another column with R,G,B values if that’s easier)

PURPOSE OF MACRO:
to work down the entire column K, cell by cell, and apply the background colour using the hex contents of the cell ie #0F320F

This is as far as I have got (with help from another forum)
This is based on VB and the syntax is not right for CALC BASIC.

HELP PLEASE!! I really need this.
Much appreciated!!

sub hexBgd4
rem ----------------------------------------------------------------------
rem define variables
dim document as object
dim dispatcher as object
rem ----------------------------------------------------------------------
rem get access to the document
document = ThisComponent.CurrentController.Frame
dispatcher = createUnoService(“com.sun.star.frame.DispatchHelper”)

rem ----------------------------------------------------------------------
rem dim args1(0) as new com.sun.star.beans.PropertyValue

Dim rCell As Object
Dim oSheet As Object
Dim i As Integer
Dim rowCount As Integer

oSheet = ThisComponent.Sheets(0)
REM rowCount = oSheet.getCellRangeByName("K1").End(4).Row + 1 // invalid VB syntax
rowCount = oSheet.getCellRangeByName("K1").End(x1Up).Row
For i = 1 To rowCount - 1
    rCell = oSheet.getCellByPosition(10, i)
    
    If Len(rCell.String) >= 7 Then
        Dim red As Long
        Dim green As Long
        Dim blue As Long

        red = CLng("&H" & Mid(rCell.String, 2, 2))
        green = CLng("&H" & Mid(rCell.String, 4, 2))
        blue = CLng("&H" & Mid(rCell.String, 6, 2))

        rCell.CellBackColor = RGB(red, green, blue)
        
        dim args3(0) as new com.sun.star.beans.PropertyValue
		args3(0).Name = "BackgroundColor"
		args3(0).Value = rCell.CellBackColor
		
		dispatcher.executeDispatch(document, ".uno:BackgroundColor", "", 0, args3())
    End If
Next i

End Sub


Many thanks!

:face_with_thermometer:

apparently not so helpful ! :confused:

sub colorCol(color as String, col as String)
    ThisComponent.CurrentController.ActiveSheet.getCellRangeByName(col+":"+col) _
    	.CellBackColor = clng(color)
end sub

sub help
  for each col in array("A","C","E")
     colorCol("&H0F320F", col)
  next 
end sub

image

HELP PLEASE!!!

Hi Pierre, thanks for your code! SORRY TO SAY IT DIDN’T WORK!!
unfortunately I have an error when running it, and each cell containing a hex colour value should be a different colour, please see the example attached that I have created.

IMAGES:
macro cells - before & after.ods|attachment](upload://AnghGOtSCFoTesKlPgKw4alRBSP.ods) (15.0 KB)

I’m sure it is a small change to your code!!
Many thanks for your help!!

VERSION:
by the way, this is LIBREOFFICE CALC v7.4 running on OS Linux Debian

I don’t know if that makes a difference to the CALC MACRO syntax.

Thanks!

Have you read the error code?
.
I’m not sure there is need to change the code.
How did you call colorCol ?
.
Have you tried to call help instead? (Not the word, but the second helper-sub in the code.

1 Like
sub colorCol()
  sheet = ThisComponent.CurrentController.ActiveSheet
  for r = 0 to 3
    color = sheet.getCellByPosition(0,r).string
 	sheet.getCellByPosition(2,r).CellBackColor = clng(replace(color, "#","&H"))
  next  	
end sub

image

1 Like

thank you so much!!!
absolutely perfect!
have a great day!

MINOR TWEAK:
is it possible to make this run on just the cells you highlight?
ie the ones with the hex value in
thanks again!!

just change the column indice :

sheet.getCellByPosition(0,r)...

image

for “simple” selections :

sub colorSel()
  sel = ThisComponent.currentselection
  with sel.RangeAddress
  for r = 0  to .endRow - .startRow
    for c = 0 to .endColumn - .startColumn
      cell = sel.getCellByPosition(c,r)
 	  cell.CellBackColor = clng(replace(cell.string, "#","&H"))
 	next
  next
  end with
end sub

image

1 Like

Hi FYP,
thank you so much, works perfectly!!
you’ve made my day!!