List (palette) of colors are being used in ActiveDocument [SOLVED]

Hi there,

I have a document with lot of different shapes and I want to group all of them with same FillColor.

I'm having troubles getting the list (palette) of colors are being used in ActiveDocument.

In CD 20020 exists the method ShapeRange.GetColors but unfortunately I'm working on X8.

Any clue?

Important: Amount of shapes is amazing (Autocad exported pdf) so looping them is almost unuseful.

Thanks in advence,


No Data
  • This code should work in all versions:

    Sub Test_01()

    Dim SR1 As ShapeRange, SR2 As ShapeRange, CurSh As Shape
    Dim ColArr(32) As String, CurCol As Integer, ColPos As Integer, ColCnt As Integer

    Set SR1 = ActivePage.Shapes.All

    ColCnt = 0
    For Each CurSh In SR1.Shapes
       If CurSh.Type = cdrEllipseShape Then
          ColPos = 0
          For CurCol = 1 To ColCnt
             If ColArr(CurCol) = CurSh.Fill.UniformColor.HexValue Then ColPos = CurCol
          Next CurCol
          If ColPos = 0 Then
             ColCnt = ColCnt + 1
             ColArr(ColCnt) = CurSh.Fill.UniformColor.HexValue
          End If
       End If
    Next CurSh
    For CurCol = 1 To ColCnt
       Set SR2 = New ShapeRange
       For Each CurSh In SR1.Shapes
          If CurSh.Fill.UniformColor.HexValue = ColArr(CurCol) Then SR2.Add CurSh
       Next CurSh
       Set CurSh = SR2.Group
       CurSh.Name = ColArr(CurCol)
    Next CurCol
    'MsgBox ColCnt

    End Sub