Trying to loop through all shapes on multiple worksheets and change color

K

korrin.anderson

Hi - I have a workbook with multiple sheets - each having a few shapes
on it. I want to change the color of the fill and line for each one.
My code works ok if I run it on just one sheet, but if I try and run it
on one sheet right after the other (with a subroutine calling this sub
twice), it gives me the "Object doesn't support the property or method"
error. Sometimes this even happens if I run the macro twice in a row
manually, sometimes it doesn't. I am seriously at my wits end....can
someone please help?

Thanks!

Here is the code I am bombing out
on...."Selection.ShapeRange.Fill.ForeColor.SchemeColor = 16" (or
whichever case it is on)


For Each sh In myDocument.Shapes
sh.Select
If sh.Type = 2 Then
Select Case colorscheme

Case "OcOl"
Selection.ShapeRange.Fill.ForeColor.SchemeColor = 16
Selection.ShapeRange.Line.ForeColor.SchemeColor = 16
With Selection.Characters.Font
.Name = "Arial"
.FontStyle = "Regular"
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = fontcolor
End With

Case "BoTe"
Selection.ShapeRange.Fill.ForeColor.SchemeColor = 34
Selection.ShapeRange.Line.ForeColor.SchemeColor = 34
With Selection.Characters.Font
.Name = "Arial"
.FontStyle = "Regular"
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = fontcolor
End With
Case "EaTe"
Selection.ShapeRange.Fill.ForeColor.SchemeColor = 34
Selection.ShapeRange.Line.ForeColor.SchemeColor = 34
With Selection.Characters.Font
.Name = "Arial"
.FontStyle = "Regular"
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = fontcolor
End With
Case "BoEa"
Selection.ShapeRange.Fill.ForeColor.SchemeColor = 35
Selection.ShapeRange.Line.ForeColor.SchemeColor = 35
With Selection.Characters.Font
.Name = "Arial"
.FontStyle = "Regular"
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = fontcolor
End With
Case Else
'Olive-Ocean is default
Selection.ShapeRange.Fill.ForeColor.SchemeColor = 1
Selection.ShapeRange.Line.ForeColor.SchemeColor = 1
With Selection.Characters.Font
.Name = "Arial"
.FontStyle = "Regular"
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = fontcolor
End With

End Select


End If
Next
 
P

Peter T

Looks like you are trying to format all callouts on the assumption they
contain text.

See this question from earlier today
Subject Font.Color - syntax error ?

In passing, it also looks like you change these throughout the entire
workbook according to your own defined colour scheme. Instead of changing
all those formats you could customize a palette colour.

Eg format everything with (say) colorindex 31 or 31+7 = schemecolor 38
(bottom left in the dropdown palette)

first from the intermediate window (ctrl-g)
?activeworkbook.Colors(16-7)
16711935
?activeworkbook.Colors(35-7)
16776960
?activeworkbook.Colors(34-7)
65535
?vbwhite
16777215

Dim newcolor as long

Select case colorscheme
case "OcOl": newcolor = 16711935
case "BoTe": newcolor = 16776960
Case "EaTe":
Case Else
'Olive-Ocean is default
Selection.ShapeRange.Fill.ForeColor.SchemeColor = 1

End select

Activeworkbook.colors(31) = newcolor

But I don't understand how 'Olive-Ocean goes to SchemeColor = 1, for me
it's vbWhite

In addition, you could set the default colour for all new shapes to be
colorindex 31 (shemecolor38), then you don't need to worry about running a
macro unless you change your colorsheme.

Just a thought

Regards,
Peter
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top