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.
Important: Amount of shapes is amazing (Autocad exported pdf) so looping them is almost unuseful.
Thanks in advence,
This code should work in all versions:
Sub Test_01()Dim SR1 As ShapeRange, SR2 As ShapeRange, CurSh As ShapeDim ColArr(32) As String, CurCol As Integer, ColPos As Integer, ColCnt As IntegerSet SR1 = ActivePage.Shapes.AllColCnt = 0For 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 IfNext CurShFor 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 ColCntEnd Sub
Unfortunately, as I said at the beginning, the document contains thousands shapes (and I have hundreds of documents) so I want to avoid a solution involving a loop through all shapes.