9 сент. 2015 г.

Быстрый экспорт в JPG

Решил сделать макрос для CorelDraw X3, который осуществляет быстрый экспорт в JPG.

Форма выглядит так:

Код макроса такой:

Private Sub CommandButton1_Click()

If UserForm10.TextBox1.Text = "" Then MsgBox "Не ввели имя файла": Exit Sub


Dim opt As New StructExportOptions
Dim expJPGfiltr As ExportFilter
Dim exp_jpg As String
Dim pg As Page


If UserForm10.CheckBox1.Value = True Then opt.ImageType = cdrCMYKColorImage Else opt.ImageType = cdrRGBColorImage
opt.ResolutionX = UserForm10.TextBox2
opt.ResolutionY = UserForm10.TextBox2
opt.Dithered = True
opt.AntiAliasingType = cdrSupersampling
opt.UseColorProfile = True

If UserForm10.CheckBox2.Value = True Then
         'файлы сохранятся там же, где лежит исходник
        exp_jpg = ActiveDocument.FilePath + UserForm10.TextBox1.Text
    Else
        'файлы сохранятся в фиксированную папку
exp_jpg = "C:\Temp" + UserForm10.TextBox1.Text
End If

'по умолчанию экспортирует только текущую страницу
'но может экспортировать и все страницы
If UserForm10.CheckBox3 = True Then

For Each pg In ActiveDocument.Pages
pg.Activate
Set expJPGfiltr = ActiveDocument.ExportBitmap(exp_jpg + Str(pg.Index) + ".jpg", cdrJPEG, cdrCurrentPage, _
    opt.ImageType, , , opt.ResolutionX, opt.ResolutionY, opt.AntiAliasingType, , , opt.UseColorProfile)
    With expJPGfiltr
        .Progressive = False
        .Optimized = True
        .Compression = 10
        .Smoothing = 5
        .Finish
    End With
Next pg
  
    Else   

Set expJPGfiltr = ActiveDocument.ExportBitmap(exp_jpg + ".jpg", cdrJPEG, cdrCurrentPage, _
    opt.ImageType, , , opt.ResolutionX, opt.ResolutionY, opt.AntiAliasingType, , , opt.UseColorProfile)
    With expJPGfiltr
        .Progressive = False
        .Optimized = True
        .Compression = 10
        .Smoothing = 5
        .Finish
    End With
  
    End If

Unload UserForm10

End Sub

Большое спасибо за помощь в создании макроса пользователю splxgf с форума rudtp.ru

Комментариев нет:

Отправить комментарий