Excel VBA: Changing the backcolor of a label with RGB

Question

I'm trying to update the backcolor of all of the labels that I have on a worksheet. I'd like to indicate the color using the RGB values, but I'm stuck in two places. Here is the code that I have right now:

Sheet2.Shapes("Label 2").Fill.BackColor.RGB = RGB(220, 105, 0)

This code will run without error, but it seems to have no effect. My label starts out white (or maybe transparent) and never changes. Can anyone tell me what I need to do to make this work?

Next, I'd like to capture this RGB value in a variable so that I don't have to re-type of repeatedly. Essentially, I'm looking for something like this:

dim col as Color
col = RGB(220,105,0)
Sheet2.Shapes("Label 2").Fill.BackColor.RGB = col

I know that there is no variable type called Color, but I think you can see what I am trying to do.

Any help is appreciated. Thanks!

Answer 1

I assume that these are labels from the Forms toolbar if in pre xl2007 or from the Insert -> Forms controls if xl2007 or xl2010. If so I don't think there is any way to color them.

As they are labels, use the drawing shapes in lieu. The following code colors a drawing shape.

Dim shp As Shape
Dim lngSelectColor As Long

lngSelectColor = 4
Set shp = Sheet2.Shapes("Rectangle 1")

shp.Fill.ForeColor.SchemeColor = lngSelectColor

To get the SchemeColors and Font colors use the following code in the following subs. Also sub at end to delete the created shapes.

Ensure that the Active sheet is empty and read the comments at the top of each sub. (I suggest a separate workbook)

Sub DisplayFillSchemeColors()
    'Output is on the ActiveSheet (Ensure it is empty)
    'Creates rectangle shapes in column A and colors them
    'Color name is the row number
    'Names the created shapes in column B
    'Creates shapes in Column A of the Active Sheet so ensure Active sheet is empty
    Dim i As Long
    Dim shp As Shape
    Dim dblLeft As Double
    Dim dblTop As Double
    Dim dblWdth As Double
    Dim dblHt As Double
   
    dblLeft = Cells(1, 1).Left
    dblWdth = Cells(1, 1).Width
    dblHt = Cells(1, 1).Height
   
    For i = 1 To 80     '80 is max SchemeColor
        dblTop = Cells(i, 1).Top    'Needs setting for each loop
        Set shp = ActiveSheet.Shapes.AddShape(msoShapeRectangle, dblLeft, dblTop, dblWdth, dblHt)
        Cells(i, 2) = shp.Name
        shp.Fill.ForeColor.SchemeColor = i
    Next i

End Sub

To get Font colors for the text use the following code. Can have same active sheet as previous code because it uses different columns.

Sub DisplayFontThemeColors()
    'Output is on the ActiveSheet (Ensure it is empty other than columns A & B with shape colors)
    'Creates rectangle shapes in column C and colors them white
    'Inserts colored text in the shape
    'Names the created shapes in column D
    Dim i As Long
    Dim shp As Shape
    Dim dblLeft As Double
    Dim dblTop As Double
    Dim dblWdth As Double
    Dim dblHt As Double
   
    dblLeft = Cells(1, 3).Left
    dblWdth = Cells(1, 3).Width
    dblHt = Cells(1, 3).Height
       
    For i = 1 To 16     '16 is max ObjectThemeColor
        dblTop = Cells(i, 3).Top    'Needs setting for each loop
        Set shp = ActiveSheet.Shapes.AddShape(msoShapeRectangle, dblLeft, dblTop, dblWdth, dblHt)
        Cells(i, 4) = shp.Name
        shp.Fill.ForeColor.SchemeColor = 1      'Set shape to White background
       
        shp.TextFrame2.TextRange.Characters.Text = shp.Name
        With shp.TextFrame2.TextRange.Font.Fill
            .Visible = msoTrue
            .ForeColor.ObjectThemeColor = i
            .Solid
        End With
    Next i
  
End Sub

Both of the above subs actually create shapes in the cells. If you want to delete all of these shapes then use the following code.

Sub DeleteAllShapes()
    'Deletes all shapes on ActiveSheet
    Dim shp As Shape
    For Each shp In ActiveSheet.Shapes
        shp.Delete
    Next shp
End Sub

 

---

Regards, OssieMac

Answer 2

Dear RandyBldr,

Have you applied the solution of Mr OssieMac ?

---

Best Regards,
Asadulla Javed, Kolkata
---------------------------------------------------------------------------------------------
Please do not forget to click “Vote as Helpful” if any post helps you and "Mark as Answer”if it solves the issue.