Sub Test()
Dim s As Shape
Dim c As New Color
If ActiveShape Is Nothing Then
  MsgBox "Select a powerclip container"
  Exit Sub
End If
If ActiveShape.Fill.Type <> cdrUniformFill Then
  MsgBox "Powerclip container must have a uniform fill"
  Exit Sub
End If
For Each s In ActiveShape.PowerClip.Shapes
  c.CopyAssign s.PowerClipParent.Fill.UniformColor
  Select Case c.Type

 Case cdrColorRGB


c.RGBBlue = (c.RGBBlue + 255) \ 2


c.RGBGreen = (c.RGBGreen + 255) \ 2


c.RGBRed = (c.RGBRed + 255) \ 2

 Case cdrColorCMYK


c.CMYKBlack = c.CMYKBlack \ 2


c.CMYKCyan = c.CMYKCyan \ 2


c.CMYKMagenta = c.CMYKMagenta \ 2


c.CMYKYellow = c.CMYKYellow \ 2

 Case Else


c.ConvertToHLS


c.HLSLightness = (c.HLSLightness + 255) \ 2
  End Select
  s.Fill.ApplyUniformFill c
Next s 
End Sub