Logo Questions Linux Laravel Mysql Ubuntu Git Menu
 

Setting a font color in VBA

I want to set the font color of a cell to a specific RGB value.

If I use

ActiveCell.Color = RGB(255,255,0)

I do get yellow, but if I use a more exotic RGB value like:

ActiveCell.Color = RGB(178, 150, 109)

I just get a grey color back.

How come can't I just use any RGB value? And do you know any workarounds?

Thanks.

like image 573
Peter Lindholm Avatar asked Dec 18 '08 14:12

Peter Lindholm


3 Answers

Excel only uses the colors in the color palette. When you set a cell using the RGB value, it chooses the one in the palette that is the closest match. You can update the palette with your colors and then choose your color and that will work.

This will let you see what is currently in the palette:

 Public Sub checkPalette()
      Dim i As Integer, iRed As Integer, iGreen As Integer, iBlue As Integer
      Dim lcolor As Long
      For i = 1 To 56
        lcolor = ActiveWorkbook.Colors(i)
        iRed = lcolor Mod &H100  'get red component
        lcolor = lcolor \ &H100  'divide
        iGreen = lcolor Mod &H100 'get green component
        lcolor = lcolor \ &H100  'divide
        iBlue = lcolor Mod &H100 'get blue component
        Debug.Print "Palette " & i & ": R=" & iRed & " B=" & iBlue & " G=" & iGreen
      Next i
    End Sub

This will let you set the palette

Public Sub setPalette(palIdx As Integer, r As Integer, g As Integer, b As Integer)
  ActiveWorkbook.Colors(palIdx) = RGB(r, g, b)
End Sub
like image 65
LeppyR64 Avatar answered Nov 19 '22 15:11

LeppyR64


A quick tip: the Excel Palette has two rows of colours which are rarely used and can usually be set to custom values without visible changes to other peoples' sheets.

Here's the code to create a reasonable set of 'soft-tone' colours which are far less offensive than the defaults:


Public Sub SetPalePalette(Optional wbk As Excel.Workbook) ' This subroutine creates a custom palette of pale tones which you can use for controls, headings and dialogues '

' ** THIS CODE IS IN THE PUBLIC DOMAIN ** ' Nigel Heffernan http://Excellerando.Blogspot.com

' The Excel color palette has two hidden rows which are rarely used: ' Row 1: colors 17 to 24 ' Row 2: colors 25 to 32 - USED BY SetGrayPalette in this workbook '

' Code to capture existing Screen Updating settting and, if necessary, ' temporarily suspend updating while this procedure generates irritating ' flickers onscreen... and restore screen updating on exit if required.

Dim bScreenUpdating As Boolean

bScreenUpdating = Application.ScreenUpdating

If bScreenUpdating = True Then Application.ScreenUpdating = False End If

'If Application.ScreenUpdating <> bScreenUpdating Then ' Application.ScreenUpdating = bScreenUpdating 'End If

If wbk Is Nothing Then Set wbk = ThisWorkbook End If

With wbk

.Colors(17) = &HFFFFD0  ' pale cyan
.Colors(18) = &HD8FFD8  ' pale green.
.Colors(19) = &HD0FFFF  ' pale yellow
.Colors(20) = &HC8E8FF  ' pale orange
.Colors(21) = &HDBDBFF  ' pale pink
.Colors(22) = &HFFE0FF  ' pale magenta
.Colors(23) = &HFFE8E8  ' lavender
.Colors(24) = &HFFF0F0  ' paler lavender

End With

If Application.ScreenUpdating <> bScreenUpdating Then Application.ScreenUpdating = bScreenUpdating End If

End Sub

Public Sub SetGreyPalette() ' This subroutine creates a custom palette of greyshades which you can use for controls, headings and dialogues

' ** THIS CODE IS IN THE PUBLIC DOMAIN ** ' Nigel Heffernan http://Excellerando.Blogspot.com

' The Excel color palette has two hidden rows which are rarely used: ' Row 1: colors 17 to 24 ' - USED BY SetPalePalette in this workbook ' Row 2: colors 25 to 32

' Code to capture existing Screen Updating settting and, if necessary, ' temporarily suspend updating while this procedure generates irritating ' flickers onscreen... remember to restore screen updating on exit!

Dim bScreenUpdating As Boolean

bScreenUpdating = Application.ScreenUpdating

If bScreenUpdating = True Then Application.ScreenUpdating = False End If

'If Application.ScreenUpdating <> bScreenUpdating Then ' Application.ScreenUpdating = bScreenUpdating 'End If

With ThisWorkbook .Colors(25) = &HF0F0F0 .Colors(26) = &HE8E8E8 .Colors(27) = &HE0E0E0 .Colors(28) = &HD8D8D8 .Colors(29) = &HD0D0D0 .Colors(30) = &HC8C8C8 ' &HC0C0C0 ' Skipped &HC0C0C0 - this is the regular 25% grey in the main palette .Colors(31) = &HB8B8B8 ' Note that the gaps are getting wider: the human eye is more sensitive .Colors(32) = &HA8A8A8 ' to changes in light greys, so this will be perceived as a linear scale End With

'The right-hand column of the Excel default palette specifies the following greys:

' Colors(56) = &H333333 ' Colors(16) = &H808080 ' Colors(48) = &H969696 ' Colors(15) = &HC0C0C0 ' the default '25% grey'

' This should be modified to improve the color 'gap' and make the colours easily-distinguishable:

With ThisWorkbook .Colors(56) = &H505050 .Colors(16) = &H707070 .Colors(48) = &H989898 ' .Colors(15) = &HC0C0C0 End With

If Application.ScreenUpdating <> bScreenUpdating Then Application.ScreenUpdating = bScreenUpdating End If

End Sub

You may choose to write a 'CaptureColors' and 'ReinstateColors' function for each workbook's Open() and BeforeClose() events... Or even for each worksheet's activate and deactivate event.

I have code lying around somewhere that creates a 'thermal' colour gradient for 3-D charts, giving you a progression from 'Cold' blue to 'Hot' reds in thirty-two steps. This is harder than you might think: a gradient of colors that will be perceived as 'equal intervals' by the human visual system (which runs on a logarithmic scale of intensity and has nonlinear weightings for red, green and blue as 'strong' colours) takes time to construct - and you have to use VBA to coerce MS Chart into using the colours you specify, in the order you specified.

like image 33
Nigel Heffernan Avatar answered Nov 19 '22 15:11

Nigel Heffernan


Sub color()

bj = CStr(Hex(ActiveCell.Interior.Color))
If Len(bj) < 6 Then
    Do Until Len(bj) = 6
        bj = "0" & bj
    Loop
End If

R = CLng("&H" & Right(bj, 2))
bj = Left(bj, Len(bj) - 2)
G = CLng("&H" & Right(bj, 2))
bj = Left(bj, Len(bj) - 2)
B = CLng("&H" & bj)

End Sub
like image 25
Marko Avatar answered Nov 19 '22 14:11

Marko