Grafik per Makro Exportieren

[Chrisbeee]

Moin Moin liebe Gemeinschaft.

Dies ist mein erster Post (Nach meiner Vorstellung) also steinigt mich nicht wenn Informationen fehlen.

Ich arbeite mit CD 2017. Könnte mir jemand erklären wie ich Grafiken per Makro / VBA als PDF und JPG exportieren kann? Der Dateiname sollte dabei aus zwei Textfeldern zusammenhängend erstellt werden.

Im weiteren Verlauf sollen mehrere nebeneinanderliegende Grafiken der Reihe nach exportiert werden wobei sich der Dateiname nur durch eine angehängte Zahl unterscheidet.

Ich hoffe, dass ich mein Anliegen einigermaßen verständlich erklären konnte

Vielen Dank
Chrisbeee

[koter]

Hallo Chris,

willkommen im Forum!

Die Grafiken müssen eine Gemeinsamkeit haben oder benannt sein, damit das Makro sie identifizieren kann:



Im Beispiel sind die Textfelder (Grafiktexte) benannt und die zu exportierenden Grafiken sind Gruppen.
Die Gruppen enthalten jeweils zwei Grafiktexte in einer bestimmten Schriftart, daran werden sie identifiziert.



Das Beispielmakro hat keinen Dialog. Den Pfad musst Du also in den Quelltext schreiben.

Code:

Sub Chrisbeee1()
   Dim f As String, q As String, Pfad As String, Dateiname As String
   Dim s As Shape
   Dim sr1 As New ShapeRange, sr2 As ShapeRange
   Dim i As Integer, z As Integer
   
   Pfad = "C:\temp\corelforum\Chrisbeee\"
   
   Dateiname = ActivePage.Shapes("Textfeld1").Text.Story & ActivePage.Shapes("Textfeld2").Text.Story
   
   ActiveDocument.PDFSettings.PublishRange = 2
   q = "@type = 'text:artistic'and  @com.text.story.font = '" & f & "'"
   f = "Humnst777 BT"
   z = 0
   
   Set sr1 = ActivePage.Shapes.FindShapes(Type:=cdrGroupShape)
   sr1.Sort " @shape1.Left < @shape2.Left "
   
   For i = 1 To sr1.Count
       Set s = sr1(i)
       Set sr2 = s.Shapes.FindShapes(Query:=q)
       If sr2.Count = 2 Then
           z = z + 1
           s.CreateSelection
           ActiveDocument.Export Pfad & Dateiname & z & ".jpg", cdrJPEG, cdrSelection
           ActiveDocument.PublishToPDF Pfad & Dateiname & z & ".pdf"
       End If
   Next i
End Sub

Deine Informationen sind tatsächlich etwas knapp, deshalb konnte ich nur mit diesem allgemeingehaltenen Beispiel antworten.
Gesteinigt wurde hier aber noch niemand. (wäre ja mal was neues!   )

Gruß

Koter

[Chrisbeee]

Vielen Dank Koter

aktuell werden die einzelnen Grafiken sowie die jeweiligen Einzelteile per Makro erstellt und positioniert, wobei sich die Grafiken, Texte etc. dann alle auf einer Ebene befinden und nicht gruppiert werden. Dies könnte ich aber auch ändern und die zusammengehörenden Grafiken gruppieren lassen.

Wäre es denn alternativ möglich die Grafiken anhand ihrer X-Y-Position auszuwählen und zu exportieren?

Also -> Markiere alle Grafiken die sich in dem Bereich von XY(A) bis XY(B) befinden und exportiere diese als JPG --> anschließend wähle alle Grafiken aus dem abweichenden Bereich XY© bis XY(D) und exportiere diese als PDF.....


Wenn ich morgen wieder an meinem Rechner im Büro bin würde ich versuchen einen Screenshot zu posten um es besser erklären zu können   

Gruß Chris

[koter]

Hallo Chris,

...Wäre es denn alternativ möglich die Grafiken anhand ihrer X-Y-Position auszuwählen und zu exportieren?...

Ja, aber wenn die Grafiken durch ein Makro erstellt werden, dann baue die Exportfunktionen doch in das Makro ein. Das Makro kennt die Positionen doch, wozu dann ein Zweites, dass die Positionen abermals ermittelt?

Gruß

Koter

[Chrisbeee]

Hallo Koter,

die "Grafiken / Artikelbilder" bestehen aus mehreren Einzelteilen welche durch das vorhandene Makro nacheinander positioniert werden.

Ich weiß z.b., dass eine der Grafiken aus folgenden Elementen besteht ->

Code:

ActiveDocument.CreateSelection ActivePage.Layers("Flaggen").Shapes(82), ActivePage.Layers("Flaggen").Shapes(81), ActivePage.Layers("Flaggen").Shapes(80), ActivePage.Layers("Flaggen").Shapes(79), ActivePage.Layers("Flaggen").Shapes(78), ActivePage.Layers("Flaggen").Shapes(77), ActivePage.Layers("Flaggen").Shapes(76), ActivePage.Layers("Flaggen").Shapes(75), ActivePage.Layers("Flaggen").Shapes(74), ActivePage.Layers("Flaggen").Shapes(73), ActivePage.Layers("#DFS").Shapes(4)

Dieses müssete als PDF exportiert werden und soll den Dateinamen #DFSXXX_YYY_WT.PDF erhalten wobei XXX in Text1 und YYY in Text2 geschrieben steht.

als nächstes müsste eine weitere Grafik ->

Code:

ActiveDocument.CreateSelection ActivePage.Layers("Flaggen").Shapes(68), ActivePage.Layers("Flaggen").Shapes(67), ActivePage.Layers("Flaggen").Shapes(66), ActivePage.Layers("Flaggen").Shapes(65), ActivePage.Layers("Flaggen").Shapes(64), ActivePage.Layers("Flaggen").Shapes(63), ActivePage.Layers("Flaggen").Shapes(62), ActivePage.Layers("Flaggen").Shapes(61), ActivePage.Layers("Flaggen").Shapes(60), ActivePage.Layers("Flaggen").Shapes(59), ActivePage.Layers("#DFS").Shapes(1)

ActiveDocument.AddToSelection ActivePage.Layers("Kontur").Shapes(39), ActivePage.Layers("Kontur").Shapes(3), ActivePage.Layers("Kontur").Shapes(2), ActivePage.Layers("Kontur").Shapes(1)

Dieses müssete als JPG exportiert werden und soll den Dateinamen #DFSXXX_YYY_AB.JPG erhalten wobei XXX in Text1 und YYY in Text2 geschrieben steht (Die selben Texte wie bei der vorherigen Grafik).


Alternativ könnte ich die einzelnen Bausteine / Shapes vorher in dem Makro gruppieren wobei ja der Ablauf der selbe sein sollte!?


PS.: Die PDF und das JPG sollten genaudie Größe der ausgewählten Grafiken haben. Also es soll nur die Auswahl exportiert werden und nicht die ganze Seite.

Viele Grüße und ein angenehmes Wochenende
Chris

[koter]

Hallo Chris,

dann muss das Makro die erstellte Auswahl nur noch exportieren.
Gruppen oder Koordinaten kannst Du also vergessen.

Den String für die Dateinamen kannst nach Deinem Muster wie in meinem Beispiel zusammenbauen.
Die Exportfunktionen kannst Du auch so verwenden, die Exportieren nur die Auswahl.

Gibt es dazu noch Fragen?

Gruß

Koter

[Chrisbeee]

Hallo Koter,

ich habe deinen Code umgebaut und es folgendermaßen probiert ->

Code:

Sub Export_Test()
  Dim f As String, q As String, Pfad As String, Dateiname As String
  Dim s As Shape
 
     
  Pfad = "C:\Users\Werkstatt\Desktop\Test"
 
  Dateiname = ActivePage.Layers("Textfelder").Shapes(2).Text.Story & ActivePage.Layers("Textfelder").Shapes(1).Text.Story
 
  ActiveDocument.PDFSettings.PublishRange = 2
  q = "@type = 'text:artistic'and  @com.text.story.font = '" & f & "'"
  f = "Humnst777 BT"
     
 ActiveDocument.CreateSelection ActivePage.Layers("Flaggen").Shapes(82), ActivePage.Layers("Flaggen").Shapes(81), ActivePage.Layers("Flaggen").Shapes(80), ActivePage.Layers("Flaggen").Shapes(79), ActivePage.Layers("Flaggen").Shapes(78), ActivePage.Layers("Flaggen").Shapes(77), ActivePage.Layers("Flaggen").Shapes(76), ActivePage.Layers("Flaggen").Shapes(75), ActivePage.Layers("Flaggen").Shapes(74), ActivePage.Layers("Flaggen").Shapes(73), ActivePage.Layers("#DFS").Shapes(4)
 
 ActiveSelection.Export Pfad & Dateiname & ".jpg", cdrJPEG, cdrSelection
 ActiveSelection.PublishToPDF Pfad & Dateiname & ".pdf"
 
End Sub

Beim Debuggen bekomme ich dann immer den Fehler -> "Laufzeitfehler '438': Objekt unterstützt diese Eigenschaft oder Methode nicht."

Im Code ist folgende Zeile markiert->

Code:

ActiveSelection.Export Pfad & Dateiname & ".jpg", cdrJPEG, cdrSelection

Vielleicht sollte ich noch anmerken, dass meine Fähigkeiten im Bereich Makros / VBA zum größten Teil darauf beruhen, dass ich meine Arbeitsschritte per Makro aufzeichne und diesen Code dann etwas umbaue.

Grüße Chris

[koter]

Guten Morgen Chris,

die Methoden „Export“ und „PublishToPDF“ gehören zum Dokument-Objekt. Das Auswahl-Objekt kennt diese nicht, deshalb erscheint die Fehlermeldung. wenn Du sie wie in meinem Beispiel verwendest, sollte es klappen.

Die Variablen q, f und s kannst Du aus dem Deklarationsteil und dem Rest des Makros entfernen.

Gruß

Koter

[Chrisbeee]

Hallo Koter,

zunächst möchte ich mich vielmals bei dir bedanken. Dank deiner Hilfe konnte ich das Makro so erstellen, dass es mir jede Menge Arbeit und Zeit erspart.

Zwei Dinge, welche aber nicht zwingend notwendig sind, würde ich gerne noch einbauen.

1.  Es wäre schön, wenn die JPEG-Bilder als RGB exportiert werden. Die PDF-Dateien sollen im CMYK bleiben
   
2.  Kann ich den Pfad auch dynamisch erstellen lassen? Also dass an den Stammpfad ein Wert angehängt wird welcher in einem Textfeld steht, sodass beim exportieren ein neuer Ordner mit dem Namen "Wert-Textfeld3) automatisch erstellt wird?
   

Ich hatte versucht Punkt 2 folgendermaßen zu löschen ->

Code:

Dim Ordner As String
       
  Order = ActivePage.Shapes("Textfeld3").Text.Story
     
  Pfad = "C:\Users\fixe-folie\Desktop\Test\" & Ordner

Das hat so aber leider nicht funktioniert.

Grüße Chris

[koter]

Hallo Chris,

1. Du kannst eine Exportoption erstellen und an den Exportbefehl anhängen.
   
2. Ordner werden nicht automatisch erstellt, Du kannst sie aber vom Makro erstellen lassen.
   

Im Beispiel sind die entsprechenden Zeilen kommentiert:

Code:

Sub Chrisbeee3()
   Dim ExpOpt As New StructExportOptions 'Exportoption deklarieren.
   Dim Pfad As String, Dateiname As String, Ordner As String
   Dim z As Integer
   
   ExpOpt.ImageType = cdrRGBColorImage 'RBG als Bildtyp in der Exportoption festlegen.
   
   Ordner = ActivePage.Shapes("Textfeld3").Text.Story
   Pfad = "C:\temp\corelforum\Chrisbeee\" & Ordner & "\"
   If Dir(Pfad, vbDirectory) = "" Then: MkDir (Pfad) 'Ordner erstellen (falls nicht vorhanden).
   Dateiname = "TestRBG"
   z = 2
   'Exportoption anhängen:
   ActiveDocument.Export Pfad & Dateiname & z & ".jpg", cdrJPEG, cdrSelection, ExpOpt
End Sub

Gruß

Koter