+ Reply to Thread
Results 1 to 2 of 2

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

  1. #1

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

    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


  2. #2
    Peter T
    Guest

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

    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


    <[email protected]> wrote in message
    news:[email protected]...
    > 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
    >




+ Reply to Thread

Thread Information

Users Browsing this Thread

There are currently 1 users browsing this thread. (0 members and 1 guests)

Bookmarks

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts

Search Engine Friendly URLs by vBSEO 3.6.0 RC 1