View Single Post
  #4  
Old 03-01-2013, 11:38
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 could modify this a bit to support all filltypes:
Code:
Sub swapcolors()
    Dim sr As ShapeRange
    
    Dim f As Fill 'Temp copy of fill
    
    Dim n As Long    ' loop counter
    Dim rn As Long   ' random shape number
    Dim tot As Long  ' total number of shapes
    
    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
            
            Set f = sr(n).Fill 'Save a copy of the fill
            sr(n).Fill.CopyAssign sr(rn).Fill 'Copy the fill from the randon shape
            sr(rn).Fill.CopyAssign f 'Apply the saved fill from the first shape
        Next n
    
    Optimization = False
    ActiveWindow.Refresh
End Sub
-Shelby
Reply With Quote