PDF per VBA aus Corel Exportieren

Code:

Option Explicit

Sub ExportDXF()

    Dim expflt As ExportFilter

    Dim l As Layer

    Dim Pfad As String, Dateiname As String

    Dim Anzahl As Integer

        

    For Each l In ActivePage.Layers: l.Printable = False: Next  'Alle Ebenen nicht druckbar schalten

    ActivePage.Layers("Platten").Printable = True    'Ebene druckbar schalten

    ActivePage.Layers("Export").Printable = True    'Ebene druckbar schalten

    Pfad = "\\hb-dc01\work\Hauptordner_FERTIGUNG\_3_LASER\Sonderanfertigung\"

    Anzahl = Dialog1.TextBox7 'Anzahl frtelegen

    Dateiname = Dialog1.TextBox6 'Dateiname festlegen

    Dateiname = Pfad & Dateiname & Replace("_Stck_X.dxf", "X", Anzahl) 'Dateiname vervollständigen und Anzahl einfügen

    

    Set expflt = ActiveDocument.ExportEx(Dateiname, cdrDXF)  'Exportfilter setzen

    With expflt

        .Version = 4 'DXF Version festlegen

        .Units = cdrMillimeter ' Maßeinheit festlegen

        .Finish ' Filter ausführen

    End With

End Sub

Code:

Sub ExportPDF()

    Dim l As Layer

    Dim Pfad As String, Dateiname As String

    Dim Anzahl As Integer

    For Each l In ActivePage.Layers: l.Printable = False: Next  'Alle Ebenen nicht druckbar schalten

    ActivePage.Layers("Export").Printable = True    'Ebene druckbar schalten

    Pfad = "\\hb-dc01\work\Hauptordner_FERTIGUNG\_3_LASER\Sonderanfertigung\"

    Anzahl = Dialog1.TextBox7 'Anzahl frtelegen

    Dateiname = Dialog1.TextBox6 'Dateiname festlegen

    Dateiname = Pfad & Dateiname & Replace("AF_Stck_X.pdf", "X", Anzahl) 'Dateiname vervollständigen und Anzahl einfügen

    

    With ActiveDocument.PDFSettings

        .PublishRange = 1

        .PageRange = "1"

        .Author = "Erstellt durch Makro"

        .TextAsCurves = True

        .Encoding = 1

        .pdfVersion = 6

    End With

    ActiveDocument.PublishToPDF Dateiname

End Sub

Code:

Sub ExportPDF()

    Dim l As Layer

    Dim Pfad As String, Dateiname As String

    Dim Anzahl As Integer

    Dim sr As ShapeRange

    Dim Rand As Double

    Dim RR As Shape

    ActiveDocument.Unit = cdrMillimeter

    

    Set sr = ActivePage.Layers("Export").Shapes.All

    For Each l In ActivePage.Layers: l.Printable = False: Next  'Alle Ebenen nicht druckbar schalten

    ActivePage.Layers("Export").Printable = True    'Ebene druckbar schalten

    Pfad = "\\hb-dc01\work\Hauptordner_FERTIGUNG\_3_LASER\Sonderanfertigung\"

    Anzahl = Dialog1.TextBox7 'Anzahl frtelegen

    Dateiname = Dialog1.TextBox6 'Dateiname festlegen

    Dateiname = Pfad & Dateiname & Replace("AF_Stck_X.pdf", "X", Anzahl) 'Dateiname vervollständigen und Anzahl einfügen

    

    Set l = ActivePage.Layers("Export")

    Rand = sr.SizeHeight * 0.05

    Set RR = l.CreateRectangle(sr.LeftX - Rand, sr.TopY + Rand, sr.RightX + Rand, sr.BottomY - Rand)

    RR.Outline.SetProperties , , CreateRGBColor(255, 255, 255)

    sr.Add RR

    sr.CreateSelection

    

    With ActiveDocument.PDFSettings

        .PublishRange = 2

        .PageRange = "1"

        .Author = "Erstellt durch Makro"

        .TextAsCurves = True

        .Encoding = 1

        .pdfVersion = 6

    End With

    ActiveDocument.PublishToPDF Dateiname

    ActiveSelectionRange.RemoveFromSelection

    RR.Delete

End Sub