Thread: Replace color
View Single Post
  #3  
Old 29-12-2007, 16:22
wOxxOm's Avatar
wOxxOm wOxxOm is offline
Senior Member
 
Join Date: Mar 2005
Posts: 836
Default

Code:
Sub repl_color()
   Dim s As Shape, clr As Color, SR As ShapeRange
   Dim pal As Palette, bClosePal As Boolean
   
   Set clr = CreateCMYKColor(100, 100, 0, 0)
   Set SR = New ShapeRange
   
   'collect shapes in SR
   For Each s In ActivePage.FindShapes
      If s.Fill.UniformColor.IsSame(clr) Then SR.Add s
   Next s
   
   'check if Pantone palette is opened in Application
   For Each pal In Palettes
      If pal.PaletteID = cdrPANTONECoated Then Exit For
   Next
   'open Pantone palette
   If pal Is Nothing Then bClosePal = True: Set pal = Palettes.OpenFixed(cdrPANTONECoated)
   
   'apply new fill
   SR.ApplyUniformFill pal.Colors(pal.FindColor("PANTONE 112 C"))
   
   If bClosePal Then pal.Close
End Sub
Reply With Quote