Глюк VBA с overprint. Нужна помощь
23/11/2009 10:44:02 #Link
Итак сделали рукописный макросик, который кидает макеты в определенную папочку ajhvfjnv tiff. все работает но в опциях объекта не нашли overprint. Его нет. Ну нет и нет. Все кидается, но без оверпринта. Так не катит.
Сделали по другому.
Записали макросик по сбросу файлика. все работает, все кидает, оверпринт прописан, но корел игнорирует значение true для оверпринта и кидает без него.
Записанный аналогичный макрос для eps работает на ура. Но eps не катит, нужен tiff.
Помогите разобраться с вопросом.
Или скиньте кто макроси для экспорта tiff с overprint
Сделали по другому.
Записали макросик по сбросу файлика. все работает, все кидает, оверпринт прописан, но корел игнорирует значение true для оверпринта и кидает без него.
Записанный аналогичный макрос для eps работает на ура. Но eps не катит, нужен tiff.
Помогите разобраться с вопросом.
Или скиньте кто макроси для экспорта tiff с overprint
Re: Глюк VBA с overprint. Нужна помощь
23/11/2009 12:18:26 #Link
что-то вспоминаю.
по всей видимости правильно делает только перевод в картинку средствами интерфейса Convert to Bitmap с включенной опцией "overprint black" (как ни странно, но это включает не только оверпринт черного но и все остальные). Потом уже это дело надо делать правой кнопкой и SaveAs (чтобы не было дополнительного пересчета пикселей). Этот процесс можно автоматизировать, разместив нижеследующий код в обычном VBA-модуле (Project->Module).
А!!! нужно будет предварительно настроить диалог преобразования в битмап, выделив любой объект, вызвав Convert to Bitmap, настроить как надо, и НАЖАТЬ ОК!!!
вот это в само начале "модуля"
Declare Function GetForegroundWindow& Lib "user32" ()
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd&, ByVal Msg&, ByVal wParam&, ByVal lParam&) As Long
Private Declare Function SetTimer& Lib "user32" (ByVal hWnd&, ByVal nID&, ByVal uElapse&, ByVal lpFunc&)
Private Declare Function KillTimer& Lib "user32" (ByVal hWnd&, ByVal uID&)
Private hTimer&
'а это где угодно ниже.
Sub ConvertToBitmapOVP()
Dim p0 As Page, sel0 As ShapeRange, p As Page, t0!, err$
On Error Resume Next
Set p0 = ActivePage
Set sel0 = ActiveSelectionRange
ActiveDocument.BeginCommandGroup "tif export with overprints"
For Each p In ActiveDocument.Pages
p.Activate
p.Shapes.All.CreateSelection
If ActiveSelectionRange.Count > 0 Then
hTimer = SetTimer(0, 1, 100, AddressOf timerSendEnter)
t0 = Timer
FrameWork.Automation.Invoke "c44919b9-e389-4c0d-8a54-8e6e3fcfade3"
Do
DoEvents
If ActiveShape.Type = cdrBitmapShape Then
With ActiveShape.Bitmap
ActiveDocument.ExportBitmap _
("d:\" & ActiveDocument.Name & " #" & p.Index & IIf(left$(p.Name, 5) <> "Page " And left$(p.Name, 9) <> "Страница ", Trim$(p.Name), "" ) & ".tif", _
cdrTIFF, cdrSelection, cdrCMYKColorImage, .SizeWidth, .SizeHeight, .ResolutionX, .ResolutionY, cdrNoAntiAliasing, _
Transparent:=False, UseColorProfile:=True, Compression:=cdrCompressionLZW).Finish
Exit Do
End With
End If
If Timer - t0 > 60! Then '1 minute
err = err & p.Index & " "
Exit Do
End If
Loop
End If
Next
ActiveDocument.EndCommandGroup
ActiveDocument.unDo
p0.Activate
sel0.CreateSelection
If Len(err) Then MsgBox err, vbExclamation, "Error pages"
End Sub
Sub timerSendEnter(ByVal hWnd&, ByVal uMsg&, ByVal idEvent&, ByVal dwTime&)
KillTimer 0, hTimer
SendMessage GetForegroundWindow(), &H111, 1, 0
End Sub
p.s. чертов ббкод вставлял смайлы в код,
по всей видимости правильно делает только перевод в картинку средствами интерфейса Convert to Bitmap с включенной опцией "overprint black" (как ни странно, но это включает не только оверпринт черного но и все остальные). Потом уже это дело надо делать правой кнопкой и SaveAs (чтобы не было дополнительного пересчета пикселей). Этот процесс можно автоматизировать, разместив нижеследующий код в обычном VBA-модуле (Project->Module).
А!!! нужно будет предварительно настроить диалог преобразования в битмап, выделив любой объект, вызвав Convert to Bitmap, настроить как надо, и НАЖАТЬ ОК!!!
вот это в само начале "модуля"
Declare Function GetForegroundWindow& Lib "user32" ()
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd&, ByVal Msg&, ByVal wParam&, ByVal lParam&) As Long
Private Declare Function SetTimer& Lib "user32" (ByVal hWnd&, ByVal nID&, ByVal uElapse&, ByVal lpFunc&)
Private Declare Function KillTimer& Lib "user32" (ByVal hWnd&, ByVal uID&)
Private hTimer&
'а это где угодно ниже.
Sub ConvertToBitmapOVP()
Dim p0 As Page, sel0 As ShapeRange, p As Page, t0!, err$
On Error Resume Next
Set p0 = ActivePage
Set sel0 = ActiveSelectionRange
ActiveDocument.BeginCommandGroup "tif export with overprints"
For Each p In ActiveDocument.Pages
p.Activate
p.Shapes.All.CreateSelection
If ActiveSelectionRange.Count > 0 Then
hTimer = SetTimer(0, 1, 100, AddressOf timerSendEnter)
t0 = Timer
FrameWork.Automation.Invoke "c44919b9-e389-4c0d-8a54-8e6e3fcfade3"
Do
DoEvents
If ActiveShape.Type = cdrBitmapShape Then
With ActiveShape.Bitmap
ActiveDocument.ExportBitmap _
("d:\" & ActiveDocument.Name & " #" & p.Index & IIf(left$(p.Name, 5) <> "Page " And left$(p.Name, 9) <> "Страница ", Trim$(p.Name), "" ) & ".tif", _
cdrTIFF, cdrSelection, cdrCMYKColorImage, .SizeWidth, .SizeHeight, .ResolutionX, .ResolutionY, cdrNoAntiAliasing, _
Transparent:=False, UseColorProfile:=True, Compression:=cdrCompressionLZW).Finish
Exit Do
End With
End If
If Timer - t0 > 60! Then '1 minute
err = err & p.Index & " "
Exit Do
End If
Loop
End If
Next
ActiveDocument.EndCommandGroup
ActiveDocument.unDo
p0.Activate
sel0.CreateSelection
If Len(err) Then MsgBox err, vbExclamation, "Error pages"
End Sub
Sub timerSendEnter(ByVal hWnd&, ByVal uMsg&, ByVal idEvent&, ByVal dwTime&)
KillTimer 0, hTimer
SendMessage GetForegroundWindow(), &H111, 1, 0
End Sub
p.s. чертов ббкод вставлял смайлы в код,
Re: Глюк VBA с overprint. Нужна помощь
23/11/2009 13:24:17 #Link
wOxxOm
Re: Глюк VBA с overprint. Нужна помощь
23/11/2009 13:26:21 #Linkу меня в опере не отжималось а другие браузеры, гомен, не юзаю...
а другие браузеры, гомен, не юзаю...Re: Глюк VBA с overprint. Нужна помощь
23/11/2009 13:31:56 #LinkwOxxOm
баг...
кликай по надписи а не по чекбоксу
баг...
кликай по надписи а не по чекбоксу
Re: Глюк VBA с overprint. Нужна помощь
23/11/2009 16:08:19 #LinkCompile error:
Constants, fixed-length strings, arrays, user-defined types and Declare statements not alowed as Public members of object modules
И что теперь?
Constants, fixed-length strings, arrays, user-defined types and Declare statements not alowed as Public members of object modules
И что теперь?
Re: Глюк VBA с overprint. Нужна помощь
23/11/2009 16:27:30 #Linkну я же сказал "обычный" модуль, блин нет времени скриншотить,
короче в проект в панельке Projects правой кнопкой "вставить" модуль
короче в проект в панельке Projects правой кнопкой "вставить" модуль
Re: Глюк VBA с overprint. Нужна помощь
23/11/2009 17:22:54 #LinkwOxxOm
Так и делал.
Вообщем поломали голову и сделали так:
Sub expjpg()
Dim op As New StructExportOptions
Dim pa As New StructPaletteOptions
Dim Filter As CorelDRAW.ExportFilter
' Dim op As New StructImportOptions
op.AntiAliasingType = cdrSupersampling
op.Dithered = False
op.ImageType = cdrCMYKColorImage
op.MaintainAspect = True
op.MaintainLayers = True
op.Compression = cdrCompressionNone
op.Overwrite = True
op.ResolutionX = 300
op.ResolutionY = 300
op.Transparent = False
op.UseColorProfile = True
kkk = cdrTIFF
named = ActiveDocument.Name
Dim s1 As Shape
Set s1 = ActivePage.Shapes.All.ConvertToBitmapEx(cdrCMYKColorImage, False, False, 300, cdrNormalAntiAliasing, True, True, 95)
Dim expflt As ExportFilter
ActiveDocument.Export "\\orange\maket\chastnye\" & named & ".tif", kkk, cdrCurrentPage, op
ActiveDocument.Undo
End Sub
Работает как часики.
2Модераторы: Предлагаю переименовать тему во что-нибудь вроде "Экспорт Tiff макросом из Корела" и закинуть в ЧАВО.
Так и делал.
Вообщем поломали голову и сделали так:
Sub expjpg()
Dim op As New StructExportOptions
Dim pa As New StructPaletteOptions
Dim Filter As CorelDRAW.ExportFilter
' Dim op As New StructImportOptions
op.AntiAliasingType = cdrSupersampling
op.Dithered = False
op.ImageType = cdrCMYKColorImage
op.MaintainAspect = True
op.MaintainLayers = True
op.Compression = cdrCompressionNone
op.Overwrite = True
op.ResolutionX = 300
op.ResolutionY = 300
op.Transparent = False
op.UseColorProfile = True
kkk = cdrTIFF
named = ActiveDocument.Name
Dim s1 As Shape
Set s1 = ActivePage.Shapes.All.ConvertToBitmapEx(cdrCMYKColorImage, False, False, 300, cdrNormalAntiAliasing, True, True, 95)
Dim expflt As ExportFilter
ActiveDocument.Export "\\orange\maket\chastnye\" & named & ".tif", kkk, cdrCurrentPage, op
ActiveDocument.Undo
End Sub
Работает как часики.
2Модераторы: Предлагаю переименовать тему во что-нибудь вроде "Экспорт Tiff макросом из Корела" и закинуть в ЧАВО.
Re: Глюк VBA с overprint. Нужна помощь
23/11/2009 17:29:27 #Linkхм, даже без спасибо за потраченное время, вот и помогай. А вставляли вы Class Module... вместо обычного.
p.s. оно хоть у вас теперь все оверпринты экспортит или только на черный?)))
p.s. оно хоть у вас теперь все оверпринты экспортит или только на черный?)))
Re: Глюк VBA с overprint. Нужна помощь
23/11/2009 18:03:40 #LinkwOxxOm
Спасибо. Хоть код и не пригодился, но натолкнул на идею, что и как делать.
Оверпинтит вроде черный только. Что собсно и надо.
Руки бы разрабам корела оторвать за такие фишки.
Спасибо. Хоть код и не пригодился, но натолкнул на идею, что и как делать.
Оверпинтит вроде черный только. Что собсно и надо.
Руки бы разрабам корела оторвать за такие фишки.
Источник: https://powerclip.ru/modules/newbb/viewtopic.php?topic_id=9074&start=0
