Code below finds all OLE objects (on active page) with part of name „BARCODE“ and convert them to curves (text is also convereted to curves) Sub BarcodeToCurves() Dim OrigSelection As ShapeRange, bc As ShapeRange, sx#, sy#, s1 As Shape ActiveDocument.BeginCommandGroup ("BARCODE") On Error GoTo ErrHandler Optimization = True Set bc = ActivePage.FindShapes(, cdrOLEObjectShape) For Each s1 In bc If InStr(s1.OLE.FullName, "BARCODE") Then s1.GetPosition sx, sy s1.Cut ActiveLayer.PasteSpecial "Metafile" Set pastesel = ActiveSelectionRange pastesel.PositionX = sx pastesel.PositionY = sy pastesel.Ungroup For Each s In pastesel If s.ZOrder = pastesel.Count Then s.Fill.ApplyUniformFill CreateCMYKColor(0, 0, 0, 0): GoTo here s.Fill.ApplyUniformFill CreateCMYKColor(0, 0, 0, 100) If s.Type = cdrTextShape Then s.ConvertToCurves here: Next s pastesel.CreateSelection pastesel.Group End If Next s1 Optimization = False ActiveDocument.EndCommandGroup ExitSub: Optimization = False ActiveWindow.Refresh Exit Sub Best regards, Mek
↧