identifying shape.type to change colour of line or fill

Hi all,

I have a bunch of shapes on a spreadsheet including lines, squares, triangles etc. I change the colour of the shape depending on some criteria and if the shape is a line I only want to change the line colour however if it is other than a line, i.e. a triangle, I want the line colour to remain the same but the fill colour to change.

            R = Application.WorksheetFunction.VLookup(Draw_Start_Cell.Offset(counter, i + 1).Value, rng, 3, False)
            G = Application.WorksheetFunction.VLookup(Draw_Start_Cell.Offset(counter, i + 1).Value, rng, 4, False)
            B = Application.WorksheetFunction.VLookup(Draw_Start_Cell.Offset(counter, i + 1).Value, rng, 5, False)
            
            On Error Resume Next
            Set shp = ActiveSheet.Shapes(Draw_Start_Cell.Offset(counter, i).Value)
            On Error GoTo Skip

            With shp
                If .Type = msoConnectorStraight Then .Line.ForeColor.RGB = RGB(R, G, B)
            End With

this is the unfinished code at the moment, the code is contained within a loop. The if .Type line changes the the boarder on squares, triangles etc which I don't want to happen, just the fill. It works as I want it to on a straight line. Any suggestions?

Cheers,
Marcus

Just to clarify what I am after I need something like this:

if .Type = "something with a fill" then

.fill.forecolor.RGB = .......

else if .Type = "shape with line only" then

.line.forecolor.RGB = .......

end if

It is the "...." item that I need code for that I have so far been unable to figure out.

Cheers,
Marcus

Hi demarc,

The following code (tested in Excel 2003 and 32 bit Excel 2010) may help you:

Option Explicit

Sub ProcessShapes()

  'Shape Type enumerations reference: https://msdn.microsoft.com/en-us/library/office/ff860759.aspx

  Dim Sh As Shape
  Dim iShapeType As Long
  
  Dim R As Long
  Dim G As Long
  Dim B As Long
  
  
  R = 255
  G = 0
  B = 255
  
  For Each Sh In ActiveSheet.Shapes
  
    iShapeType = Sh.Type
    
    If iShapeType = msoAutoShape Then
    
      Sh.Line.ForeColor.RGB = RGB(R, G, B)
      Sh.Fill.ForeColor.RGB = RGB(R, G, B)
      
    ElseIf iShapeType = msoLine Then
    
      Sh.Line.ForeColor.RGB = RGB(R, G, B)
      
    End If

  Next Sh

End Sub

It is a best practice to declare all variables. If you misspell a variable in your code, VBA will silently assume it is a Variant variable and go on executing with no clue to you that you have a bug. Go to the VBA development window, click Tools, Options, and check "Require Variable Declaration." This will insert the following line at the top of all new modules:

Option Explicit

This option requires all variables to be declared and will give a compiler error for undeclared variables.

Lewis

Hi Lewis,

I ended up solving my problem with this:

            R = Application.WorksheetFunction.VLookup(Draw_Start_Cell.Offset(counter, i + 1).Value, rng, 3, False)
            G = Application.WorksheetFunction.VLookup(Draw_Start_Cell.Offset(counter, i + 1).Value, rng, 4, False)
            B = Application.WorksheetFunction.VLookup(Draw_Start_Cell.Offset(counter, i + 1).Value, rng, 5, False)
            
            On Error Resume Next
            Set shp = ActiveSheet.Shapes(Draw_Start_Cell.Offset(counter, i).Value)
            On Error GoTo Skip
            
            With shp
                If InStr(1, shp.Name, "Sq", 1) Then
                    .Fill.ForeColor.RGB = RGB(R, G, B)
                ElseIf InStr(1, shp.Name, "Tri", 1) Then
                    .Fill.ForeColor.RGB = RGB(R, G, B)
                    .Line.ForeColor.RGB = RGB(R, G, B)
                ElseIf InStr(1, shp.Name, "Cir", 1) Then
                    .Fill.ForeColor.RGB = RGB(R, G, B)
                Else
                    .Line.ForeColor.RGB = RGB(R, G, B)
                End If
            End With

I make sure each shape for a square has a "Sq" in it, circle names with a "Cir" in it etc. This way it will know which requires a fill colour change and which requires a line colour change, or in the case of triangles both.

Not sure if it is the most efficient way but works fine for my purposes.

Thanks for your code and sorry I didn't mark this as solved sooner!

Marcus