ВОПРОС / ОТВЕТ ДЛЯ НАЧИНАЮЩИХ

Форум: 

Объясню на примере, чтоб было понятней... Открываю в кореле картинку (футболку с надписью) в формате JPG, мне нужно вытянуть из футболки надпись, т.е разъеденить файл... Говорят нужно формат изменить, еще что-то... Объясните, пожалуйста, что нужно сделать для этого...? Заранее спасибо.

shark, а как добавить сбор информации не только постранично, но и с листов. Т.е. если открыты два и более файлов.

делается цикл по всем документам, получаемым через ActiveDocument.Application.Documents. А дальше всё как в том макросе - цикл по страницам, слоям и так далее

С учётом советов:

Sub exportImagesFromCDR()
  Dim d As Document, p As Page, l As Layer, s As Shape, b As Bitmap
  Dim FileName$, filePath$, Counter&, ef As ExportFilter
  Dim expOpts As New StructExportOptions
  
  On Error GoTo NextDoc
  For Each d In Documents
    d.Activate
    'Сохраняет в папку с документом, вновь созданные (несохранённые) документы игнорируются
    If Len(d.filePath) Then filePath = d.filePath Else GoTo NextDoc
    Counter = 1
    For Each p In d.Pages
        For Each s In p.FindShapes(, cdrBitmapShape, True)
          FileName = Counter & "_" & IIf(Len(s.Name), s.Name, "Image")
          Set b = s.Bitmap
          On Error Resume Next
          ' Сначала пробуем «родное» сохранение растров.
          Set ef = b.SaveAs(filePath & FileName & ".jpg", cdrJPEG)
          If Err.Number = 0 Then
            ef.Finish
          Else
            ' «Родное» сохранение растра «провалилось» — используем стандартный экспорт
            p.Activate: s.CreateSelection
            expOpts.ImageType = b.Mode
            expOpts.AntiAliasingType = cdrNoAntiAliasing
            expOpts.ResolutionX = b.ResolutionX
            expOpts.ResolutionY = b.ResolutionY
            expOpts.SizeX = b.SizeWidth
            expOpts.SizeY = b.SizeHeight
            ActiveDocument.Export filePath & FileName & ".jpg", cdrJPEG, cdrSelection, expOpts
          End If
          Counter = Counter + 1
          ' Открывает папку с сохранёнными растрами
          If Counter = 2 Then Shell "explorer /select," + Chr(34) + filePath & FileName & ".jpg" + Chr(34), vbMaximizedFocus
        Next s
    Next p
NextDoc:
  Next d
End Sub

Проходит по всем открытым сохранённым документам. Группы обрабатываются, контейнеры — нет. Цветовой режим (RGB/CMYK) сохраняется, как и размеры с разрешенем.
(Часть растров не сохраняется предназначенной для этого функцией, к ним применяется стандартный экспорт. Ну, это чисто технический комментарий...)

ildar_1988 Нет слов ))) Сохраняет со ВСЕХ документов !!!!!! НО! Группы, не обрабатываются. Я приложил файл для примера. Может я что-то не так понимаю.
P.S. Не мог сразу ответить - работы, спину не разогнуть.

NemoSUN, в этом файле всего два растра (судя по свойствам документа и по поиску) и они оба экспортируются. Может, другие файлы проблемные? Приложите их. Или версии Корела у нас разные... У меня 16-я, какая у Вас?

ildar_1988, я говорю не о растре, а об обработке сгруппированных обьектов, которое не идёт. Там где вырезы в стекле.

NemoSUN, то есть Вам требуются растры и группы объектов? Если так, то группы любые (все подряд)?

ildar_1988, так вот же "...Проходит по всем открытым сохранённым документам. Группы обрабатываются, контейнеры — нет..." - писАлось в посте #906. Или имелись какие либо иные группы ? И какие группы тогда СЕЙЧАС обрабатываются ?

NemoSUN, я имел в виду, что макрос теперь способен отыскать растры в группах. (Изначально ведь обсуждалась проблема «вытащить» разом все растры из документа.)

ildar_1988, ааа, ну да. Великолепно получилось !!! С меня премия )
А есть VBA опции чтобы можно было сохранять также ТОЛЬКО группу обьектов при условии что в них нет растра ?

Страницы