Export to Eps - нужна помощь.
Приветствую всех.
Из разных кусочков создал под себя макрос для быстрого экспорта в EPS. Но так как последний раз программировал лет эдак 15-20 назад (в Pascal-e), то естественно имеются сложности.
Вот текст "моего" шедевра:
Sub EPS_1()
If ActiveDocument Is Nothing Then Beep: Exit Sub
Dim expopt As StructExportOptions, expflt As ExportFilter, d As Document, s$
Set expopt = CreateStructExportOptions
expopt.UseColorProfile = True
Set d = ActiveDocument
s = "C:\export\" & d.Name & ".eps"
Set expflt = ActiveDocument.ExportEx(s, cdrEPS, cdrSelection, expopt)
With expflt
.Header = 1 ' FilterEPSLib.epsTIFFHeader
.TIFFHeaderType = 4 ' FilterEPSLib.epsTIFFColor8
.Resolution = 96
.Transparent = False
.TextAsCurves = True
.IncludeFonts = False
.MaintainOPILinks = False
.AdjustFountainSteps = False
.FountainSteps = 128
.PSLevel = 3 ' FilterEPSLib.epsPSLevel3
.UserName = ""
.UseJPEGCompression = False
.JPEGCompression = 2
.PreserveOverprints = True
.OverprintBlack = False
.AutoSpread = False
.FixedWidth = False
.MaxSpread = 0.000142
.TextSpread = 0.005102
.BoundingBox = 0 ' FilterEPSLib.epsObjects
.UseBleed = False
.Bleed = 31750#
.CropMarks = False
.UseFloatNumbers = False
.ConvertSpot = False
.OutputObjectColorMode = 3 ' FilterEPSLib.epsObjectsNative
.ConvertSpotColorsTo = 0 ' FilterEPSLib.epsColorCMYK
.Finish
End With
End Sub
1. При сохранении файл получается следующего вида "XXX.cdr.eps"
где ".cdr" явно лишнее. С этим можно жить, но как то не красиво.
2. Если из одного открытого файла необходимо отправит на экспорт 2 и более раз, то каждый последующий замещает предыдущий. Можно ли в название файла вставить какую нибудь переменную, например текущее время?
1. Вообще Name возвращает только имя, без типа. Хотя может в старых версиях это иначе работает.
А вообще так:
s = "C:\export\" & Replace(d.Name, ".cdr", "") & _Hex$(Now) & Hex$(Timer) & ".eps"
п.с. оборачивай код тегом code
Огромное спасибо. Дальше я разберусь.
p.s. Дата и время получаются в неудобоваримом виде ( xxx9E711163B.eps) , а как их привести нормальному виду? Нужно HEX заменить на что то?
Добавлено (18.01.2011, 00:48)
---------------------------------------------
Разобрался. Может кому пригодится.
Sub EPS_1()
If ActiveDocument Is Nothing Then Beep: Exit Sub
Dim expopt As StructExportOptions, expflt As ExportFilter, d As Document, s$
Set expopt = CreateStructExportOptions
expopt.UseColorProfile = True
Set d = ActiveDocument
s = "C:\Documents and Settings\Администратор\Рабочий стол\" & Replace(d.Name, ".cdr", "") & "_" & Format(Now, "dd.mm.yy _ hh.nn.ss") & ".eps"
Set expflt = ActiveDocument.ExportEx(s, cdrEPS, cdrSelection, expopt)
With expflt
.Header = 1 ' FilterEPSLib.epsTIFFHeader
.TIFFHeaderType = 4 ' FilterEPSLib.epsTIFFColor8
.Resolution = 96
.Transparent = False
.TextAsCurves = True
.IncludeFonts = False
.MaintainOPILinks = False
.AdjustFountainSteps = False
.FountainSteps = 128
.PSLevel = 3 ' FilterEPSLib.epsPSLevel3
.UserName = ""
.UseJPEGCompression = False
.JPEGCompression = 2
.PreserveOverprints = True
.OverprintBlack = False
.AutoSpread = False
.FixedWidth = False
.MaxSpread = 0.000142
.TextSpread = 0.005102
.BoundingBox = 0 ' FilterEPSLib.epsObjects
.UseBleed = False
.Bleed = 31750#
.CropMarks = False
.UseFloatNumbers = False
.ConvertSpot = False
.OutputObjectColorMode = 3 ' FilterEPSLib.epsObjectsNative
.ConvertSpotColorsTo = 0 ' FilterEPSLib.epsColorCMYK
.Finish
End With
End Sub