View Single Post
  #3  
Old 03-01-2013, 06:58
nic nic is offline
Member
 
Join Date: May 2009
Posts: 90
Default

Thanks for your help FaneDuru, it gave me enough to make it work. It's rather inelegant but this worked

Code:
Sub swapcolors()

Dim sr As ShapeRange

Dim r As Single, g As Single, b As Single    'rgb values of shapes
Dim r2 As Single, g2 As Single, b2 As Single

Dim n As Double    ' loop counter
Dim rn As Single   ' random shape number
Dim tot As Single  ' 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

'get the rgb values of both shapes

With sr.Shapes(n).Fill.UniformColor
        If .Type = cdrColorRGB Then
            r = .RGBRed
            g = .RGBGreen
            b = .RGBBlue
        End If
    End With
    
With sr.Shapes(rn).Fill.UniformColor
        If .Type = cdrColorRGB Then
            r2 = .RGBRed
            g2 = .RGBGreen
            b2 = .RGBBlue
        End If
    End With
    
'swap their colours
    
sr.Shapes(n).Fill.UniformColor.RGBAssign r2, g2, b2
sr.Shapes(rn).Fill.UniformColor.RGBAssign r, g, b

Next n

Optimization = False
ActiveWindow.Refresh
End Sub
Reply With Quote