View Single Post
  #9  
Old 03-01-2013, 15:16
shelbym's Avatar
shelbym shelbym is offline
Senior Member
 
Join Date: Nov 2002
Location: Cheyenne, WY
Posts: 1,782
Blog Entries: 11
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:
Code:
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
    ActiveWindow.Refresh
End Sub
-Shelby
Reply With Quote