View Single Post
Old 03-01-2013, 16:16
shelbym's Avatar
shelbym shelbym is offline
Senior Member
Join Date: Nov 2002
Location: Cheyenne, WY
Posts: 1,788
Blog Entries: 12
Send a message via ICQ to shelbym Send a message via AIM to shelbym Send a message via MSN to shelbym Send a message via Yahoo to shelbym
Default Swap the colors of shapes

You don't need to create a shape, you can just store the color:
Sub swapcolors3()
    Dim sr As ShapeRange
    Dim n As Long    ' loop counter
    Dim rn As Long   ' random shape number
    Dim tot As Long  ' total number of shapes
    Dim c As New Color   ' temp shape to hold colour
    Set sr = ActiveLayer.Shapes.All
    tot = sr.Count
    Optimization = True
        For n = 1 To tot               ' loop thru all the shapes in order
        rn = Int(Rnd * (tot)) + 1      ' select a random shape

        c.CopyAssign sr.Shapes(rn).Fill.UniformColor
        sr.Shapes(rn).Fill.ApplyUniformFill sr.Shapes(n).Fill.UniformColor
        sr.Shapes(n).Fill.ApplyUniformFill c
        Next n
    Optimization = False
End Sub
Reply With Quote