Excel VBA to Cycle Through Colours / Texture Fills Of Shape

[stuarto606]

Good afternoon,

This is my first post so please bear with me! I work with Excel quite a bit for work but I'm not experienced with VBA other than recording some very basic macros!

I'm building a very simple dashboard and have assigned a button to a macro which changes the colour and texture fill of a shape. it works if I don't add the texture fill (marble) and I can't get it to go back from Marble to Red and I hope someone can help.

It fails on the lines I've highlighted in red.

Here's the code:
Sub MarbleTest()

Dim Pie_1 As Shape

If ActiveSheet.Shapes("Pie 1").Fill.ForeColor.RGB = RGB(255, 0, 0) Then
ActiveSheet.Shapes("Pie 1").Fill.ForeColor.RGB = RGB(146, 208, 8)

ElseIf ActiveSheet.Shapes("Pie 1").Fill.ForeColor.RGB = RGB(146, 208, 8) Then
ActiveSheet.Shapes("Pie 1").Fill.ForeColor.RGB = RGB(121, 142, 224)

ElseIf ActiveSheet.Shapes("Pie 1").Fill.ForeColor.RGB = RGB(121, 142, 224) Then
ActiveSheet.Shapes("Pie 1").Fill.ForeColor.RGB = RGB(255, 192, 0)

ElseIf ActiveSheet.Shapes("Pie 1").Fill.ForeColor.RGB = RGB(255, 192, 0) Then
ActiveSheet.Shapes("Pie 1").Fill.PresetTextured msoTextureWhiteMarble

ElseIf ActiveSheet.Shapes("Pie 1").Fill.ForeColor.PresetTextured = (msoTextureWhiteMarble) Then
ActiveSheet.Shapes("Pie 1").Fill.ForeColor.RGB = RGB(255, 0, 0)

End If

End Sub

 

[Micron]

You declare an object variable but don't use it? Doing so would eliminate a lot of repeated typing.
I think the syntax for the 1st red line is ActiveSheet.Shapes("Pie 1").Fill.Type = (msoTextureWhiteMarble) Then
If the next line won't do what you want, I'd say it's because the texture has to be removed before the colour can be applied. Not sure how to do that but will give it a try.
Please post code within code tags (vba button on posting toolbar) to maintain indentation and readability. You might want to consider using a Select Case block when you have a lot of logical tests to make.

 

[JohnDM]

When the Shape has a texture then it's color is white, which is RGB(255, 255, 255). To turn a textured Shape back to having a solid color, use .Solid

Here I've also used a With block to simplify the code:

Sub MarbleTest()
    With ActiveSheet.Shapes("Pie 1").Fill
        If .ForeColor.RGB = RGB(255, 0, 0) Then
            .ForeColor.RGB = RGB(146, 208, 8)
        
        ElseIf .ForeColor.RGB = RGB(146, 208, 8) Then
            .ForeColor.RGB = RGB(121, 142, 224)
        
        ElseIf .ForeColor.RGB = RGB(121, 142, 224) Then
            .ForeColor.RGB = RGB(255, 192, 0)
        
        ElseIf .ForeColor.RGB = RGB(255, 192, 0) Then
            .PresetTextured msoTextureWhiteMarble
        
        ElseIf .ForeColor.RGB = RGB(255, 255, 255) Then
            .Solid
            .ForeColor.RGB = RGB(255, 0, 0)
        End If
    End With
End Sub

 

[Micron]

Once again I seem to relish in punishing myself while trying to learn this stuff!
Since I spent so much time on this, and in case it helps anyone in the future, here's my approach (seeing as how I mentioned a Select Case block and using the object variable). Change shape name to suit:

Sub Oval1_Click()
Dim oShape As Shape

Set oShape = ActiveSheet.Shapes("Oval1")

Select Case oShape.Fill.ForeColor.RGB
     Case RGB(255, 0, 0)
          oShape.Fill.ForeColor.RGB = RGB(146, 208, 8)
     Case RGB(146, 208, 8)
          oShape.Fill.ForeColor.RGB = RGB(121, 142, 224)
     Case RGB(121, 142, 224)
          oShape.Fill.ForeColor.RGB = RGB(255, 192, 224)
     Case RGB(255, 192, 224)
          oShape.Fill.PresetTextured msoTextureWhiteMarble
     Case RGB(255, 255, 255)
          With oShape.Fill
              .Solid
              .ForeColor.RGB = RGB(255, 0, 0)
          End With
End Select

I was testing if If oShape.Fill.TextureType = -2 And oShape.Fill.ForeColor = vbWhite (as in when the marble effect was set) but found that I had to set it to white, then solid, then red. Thanks to @JohmDM I see that's not necessary in the above so I removed it.

 

[stuarto606]

Good morning, Thank you so much for getting back to me and for helping me get to a working solution! I was honestly stuck on it for hours last Friday trying all sorts of different options!