Добрый день.
Задача в том, чтобы выбранные объекты в открытом документе растрировать и экспортировать в пдф.
Макрос работает, но при сохранении пдф тихо перезаписывает файл, если он уже был создан ранее.
Как добавить проверку наличия файла в папке, и если он найден добавить префикс (например имяфайла_1.pdf) ?
Задача в том, чтобы выбранные объекты в открытом документе растрировать и экспортировать в пдф.
Макрос работает, но при сохранении пдф тихо перезаписывает файл, если он уже был создан ранее.
Как добавить проверку наличия файла в папке, и если он найден добавить префикс (например имяфайла_1.pdf) ?
Код:
Sub to_rst()
Dim Path As String
Dim Name As String
Dim NewFileName As String
Path = ActiveDocument.FilePath
Name = ActiveDocument.FileName
Name = Left(Name, Len(Name) - 4)
NewFileName = (Path + Name & "_RST600" & ".pdf")
'If Dir("NewFileName") <> "" Then
' MsgBox "Exists"
'Else
Dim Sel As ShapeRange
Set Sel = ActiveSelectionRange
Dim s1 As Shape
Set s1 = Sel.ConvertToBitmapEx(4, False, True, 600, 1, True, False, 95)
With ActiveDocument.PDFSettings
.PublishRange = 0 ' CdrPDFVBA.pdfWholeDocument
.PageRange = "1"
.Author = ""
.Subject = ""
.Keywords = ""
.BitmapCompression = 3 ' CdrPDFVBA.pdfZIP
.JPEGQualityFactor = 2
.TextAsCurves = False
.EmbedFonts = True
.EmbedBaseFonts = True
.TrueTypeToType1 = True
.SubsetFonts = True
.SubsetPct = 80
.CompressText = True
.Encoding = 1 ' CdrPDFVBA.pdfBinary
.DownsampleColor = True
.DownsampleGray = True
.DownsampleMono = True
.ColorResolution = 300
.MonoResolution = 1200
.GrayResolution = 300
.Hyperlinks = False
.Bookmarks = False
.Thumbnails = False
.Startup = 0 ' CdrPDFVBA.pdfPageOnly
.ComplexFillsAsBitmaps = False
.Overprints = True
.Halftones = False
.MaintainOPILinks = True
.FountainSteps = 256
.EPSAs = 0 ' CdrPDFVBA.pdfPostscript
.pdfVersion = 0 ' CdrPDFVBA.pdfVersion12
.IncludeBleed = True
.Bleed = 31750
.Linearize = False
.CropMarks = False
.RegistrationMarks = False
.DensitometerScales = False
.FileInformation = False
.ColorMode = 3 ' CdrPDFVBA.pdfNative
.EmbedFilename = ""
.EmbedFile = False
.JP2QualityFactor = 2
.TextExportMode = 0 ' CdrPDFVBA.pdfTextAsUnicode
.PrintPermissions = 0 ' CdrPDFVBA.pdfPrintPermissionNone
.EditPermissions = 0 ' CdrPDFVBA.pdfEditPermissionNone
.ContentCopyingAllowed = False
.OpenPassword = ""
.PermissionPassword = ""
.EncryptType = 2 ' CdrPDFVBA.pdfEncryptTypeAES
.OutputSpotColorsAs = 0 ' CdrPDFVBA.pdfSpotAsSpot
.OverprintBlackLimit = 95
.ProtectedTextAsCurves = True
End With
ActiveDocument.PublishToPDF (NewFileName)
'End If
End Sub
