Просматривают:
1 Анонимно
поиск PowerClip и в его содержимом |
||
|
||
---|---|---|
Пользователь 2 уровня
Присоединился:
2008/2/4 10:01 Откуда Москва
Сообщений: 49
|
Есть документ, страницы, нужно находить "PowerClip"ы и проверять содержимое на присутствие допустим еще одного "PowerClip"а и других обьектов например с оверпринтом. помогите с кодом
Dim i For i = 1 To ActiveDocument.Pages.Count For Each s In ActiveDocument.Pages(i).Shapes.FindShapes (???????) If s.?Поверклип Then MsgBox "Ура нашелся!!" Dim t For t = 1 To ActiveDocument.Pages.Count For Each w In ActiveDocument.Pages(i).Shapes.FindShapes If w."градиент" Then MsgBox "Пантоновый градиент оверпринтом!!!!" End If Exit For End If Next q End If Next s Next i
Опубликовано: 2010/2/25 19:05
|
|
|
Re: поиск PowerClip и в его содержимом |
|
---|---|---|
Титан - модератор
Присоединился:
2006/4/8 19:42 Сообщений: 152
|
я использую подход для перебора поверклипов без рекурсивной функции, что есть хорошо.
Dim sr As ShapeRange, sr2 As ShapeRange, sh As Shape, pageIdx& Set sr = New ShapeRange: Set sr2 = New ShapeRange For pageIdx = 1 To ActiveDocument.Pages.Count sr.AddRange ActiveDocument.Pages(pageIdx).FindShapes Do For Each sh In sr '.................. 'проверки '.................. If Not sh.PowerClip Is Nothing Then sr2.AddRange sh.PowerClip.shapes.FindShapes Next sh sr.RemoveAll: sr.AddRange sr2: sr2.RemoveAll Loop Until sr.Count = 0 Next pageIdx а для проверок цветов градиента что-нибудь вроде такого: Sub CheckOverprint() Dim sr As ShapeRange, sr2 As ShapeRange, sh As Shape, pageIdx& On Error Resume Next Set sr = New ShapeRange: Set sr2 = New ShapeRange For pageIdx = 1 To ActiveDocument.Pages.Count sr.AddRange ActiveDocument.Pages(pageIdx).FindShapes Do 'перебор поверклипов For Each sh In sr 'перебор шейпов If sh.OverprintOutline And sh.Outline.Type <> cdrNoOutline Then If sh.Outline.Color.IsSpot Then 'спотовый цвет на обводке оверпринтом End If End If If sh.OverprintFill Then Select Case sh.Fill.Type Case cdrUniformFill If sh.Fill.UniformColor.IsSpot Then 'спотовый цвет на заливке оверпринтом End If Case cdrFountainFill 'проверяем на цвета градиента For i = 0 To sh.Fill.Fountain.Colors.Count + 1 'в массиве два доп. индекса для начала и конца градиента If sh.Fill.Fountain.StartColor.IsSpot Then 'найден спотовый цвет End If Next End Select End If If Not sh.PowerClip Is Nothing Then 'найден powerclip, добавляем содержимое в дальнейший перебор sr2.AddRange sh.PowerClip.shapes.FindShapes End If Next sh 'пополняем основной список для перебора найденными powerclip'ами sr.RemoveAll: sr.AddRange sr2: sr2.RemoveAll Loop Until sr.Count = 0 Next pageIdx End Sub p.s. да, кстати... в ВБА никогда не следует объявлять ShapeRange, Collection через слово NEW (Dim sr as new shaperange), т.к. из-за глюка вба доступ к таким массивам тормозится раз в 2-10 при обработке сложных многообъектных макетов.
Опубликовано: 2010/2/25 19:34
|
|