Is there a macro for exporting PDF and coreldraw x15 in single click?

Thank you for the reply. but that code is not working for coreldraw x7. Any other suggestion?

Additionally, i want to save coreldraw file to version x5. can i get a combined macro for these two options?

I use this code and it works fine with both X6 and X7. It resamples the images and saves the corel file prior to exporting the pdf. Be aware that a password is set for the pdf, you may want to change that. Also check the color settings, these might not fit your needs.

Vidar

Sub pdf_exporter()
Static dpi&
Dim sr As ShapeRange, sh As Shape, sr2 As ShapeRange, srSel As ShapeRange, p As Page
Dim dpi0&, cnt&, cvt&(), i&, j&, s$, bStat%, t0!, x#, y#, w#, h#
On Error Resume Next
If ActiveDocument Is Nothing Then Exit Sub
If dpi <= 0 Then dpi = 300
's = InputBox("Set resolution in DPI", "Kortshop resample", IIf(dpi <= 0, 300, dpi))
s = "300"
If Len(s) = 0 Then Exit Sub
dpi = Val(s): dpi0 = (dpi * 120) \ 100
Set sr = New ShapeRange
Set sr2 = New ShapeRange
Set srSel = New ShapeRange
sr.AddRange ActiveSelection.Shapes.FindShapes
If sr.Count = 0 Then For Each p In ActiveDocument.Pages: sr.AddRange p.FindShapes: Next
cnt = sr.Count: ReDim cvt(ActiveDocument.Pages.Count)
ActiveDocument.ReferencePoint = cdrCenter
bStat = (Application.VersionMajor > 11)
If bStat Then Application.Status.BeginProgress CanAbort:=True
Do
For Each sh In sr
i = i + 1: If bStat Then If Timer - t0 > 0.1! Then t0 = Timer: Application.Status.Progress = i / cnt * 100: If Application.Status.Aborted Then Exit For
If sh.Type = cdrBitmapShape Then
With sh.Bitmap
If (.ResolutionX > dpi0) Or (.ResolutionY > dpi0) Then
If .ResolutionX * .ResolutionY > 0 Then
sh.GetPosition x, y: sh.GetSize w, h
.Resample Round(dpi / .ResolutionX * .SizeWidth + 0.49999), Round(dpi / .ResolutionY * .SizeHeight + 0.49999), True, dpi, dpi 'X3
sh.SetSize w, h: sh.SetPosition x, y
j = sh.Layer.Page.Index And &HFFFF
cvt(j) = cvt(j) + 1
srSel.Add sh
End If
End If
End With
End If
If Not sh.PowerClip Is Nothing Then _
With sh.PowerClip.Shapes.FindShapes: cnt = cnt + .Count: sr2.AddRange .All: End With
Next
sr.RemoveAll
sr.AddRange sr2
sr2.RemoveAll
If Application.Status.Aborted Then Exit Do
Loop Until sr.Count = 0
If srSel.Count Then srSel.CreateSelection Else ActiveDocument.ClearSelection
If bStat Then Application.Status.EndProgress

j = 0
For i = 1 To UBound(cvt)
If cvt(i) Then j = j + cvt(i): s = s & "p." & i & ": " & cvt(i) & ", " & vbTab
Next
'MsgBox IIf(Len(s), s, "No images was resampled"), , "Resampled: " & j & " images to " & dpi & " dpi"

Dim nPos As Long
Dim strName As String
'--------X6.2 version ------------
With ActiveDocument.PDFSettings
.PublishRange = 0 ' CdrPDFVBA.pdfWholeDocument
.PageRange = "1"
.Author = "Kortshop PDFexport Macro v.1.0"
.Subject = ""
.Keywords = ""
.BitmapCompression = pdfJPEG
.JPEGQualityFactor = 25
.TextAsCurves = True
.EmbedFonts = True
.EmbedBaseFonts = True
.TrueTypeToType1 = True
.SubsetFonts = True
.SubsetPct = 80
.CompressText = True
.Encoding = pdfBinary ' CdrPDFVBA.pdfBinary
.DownsampleColor = True
.DownsampleGray = True
.DownsampleMono = True
.ColorResolution = 96
.MonoResolution = 300
.GrayResolution = 300
.Hyperlinks = False
.Bookmarks = False
.Thumbnails = False
.Startup = 0 ' CdrPDFVBA.pdfPageOnly
.ComplexFillsAsBitmaps = False
.Overprints = True
.Halftones = True
.MaintainOPILinks = False
.FountainSteps = 256
.EPSAs = 1 ' CdrPDFVBA.pdfPreview
.pdfVersion = pdfVersion12 'pdfVersionPDFX3
.IncludeBleed = False
.bleed = 31750
.Linearize = True
.CropMarks = False
.RegistrationMarks = False
.DensitometerScales = False
.FileInformation = False
.ColorMode = pdfRGB
.EmbedFilename = ""
.EmbedFile = False
.TextExportMode = 0 ' CdrPDFVBA.pdfTextAsUnicode
.PrintPermissions = pdfPrintPermissions.pdfPrintPermissionHighResolution
.EditPermissions = pdfEditPermissionAny ' CdrPDFVBA.pdfEditPermissionNone
.ContentCopyingAllowed = False
.OpenPassword = ""
.PermissionPassword = "pwd"
.EncryptType = 1 ' CdrPDFVBA.pdfEncryptTypeStandard
.OutputSpotColorsAs = pdfSpotAsRGB ' CdrPDFVBA.pdfSpotAsSpot
.OverprintBlackLimit = 95
'--------------------------
End With



Dim dirName As String
dirName = ActiveDocument.FilePath
strName = ActiveDocument.filename
nPos = InStrRev(strName, ".")
If nPos > 0 Then strName = Left(strName, nPos - 1)
strName = dirName & strName & ".pdf"

If Dir(strName) <> "" Then 'Checking if file exists
Dim filenum As Integer, errnum As Integer
On Error Resume Next ' Turn error checking off.
filenum = FreeFile() ' Get a free file number.
' Attempt to open the file and lock it.
Open strName For Input Lock Read As #filenum
Close filenum ' Close the file.
errnum = Err ' Save the error number that occurred.
On Error GoTo 0 ' Turn error checking back on.

' Check to see which error occurred.
Select Case errnum

' No error occurred.
' File is NOT already open by another user.
Case 0
IsFileOpen = False
ActiveDocument.PublishToPDF strName
ActiveDocument.Save
Response = MsgBox("Resampled: " & j & " images " & dpi & " dpi and saved PDF", vbOKOnly + vbInformation, "Publish to PDF")

' Error number for "Permission Denied."
' File is already opened by another user.
Case 70
IsFileOpen = True
Response = MsgBox("The file: " & strName & " is open, please close it and try again ", vbOKOnly + vbCritical, "File is open")
' Another error occurred.
Case Else
Error errnum
End Select
Else
ActiveDocument.PublishToPDF strName
ActiveDocument.Save
Response = MsgBox("Resampled: " & j & " images " & dpi & " dpi and saved PDF", vbOKOnly + vbInformation, "Publish to PDF")
End If

End Sub

To publish selected objects only, try replacing .PublishRange = 0 ' CdrPDFVBA.pdfWholeDocument with .PublishRange = pdfSelection

Saving to X15 I do not know how to do

Vidar