Makro in PhotoPaint

[Karthagos]

Hallo Koter,
danke für das überarbeitete Makro, klappt prinzipiell auch mit 2019, aber
ich bekomme folgende Eingabemaske
   
bei Dateiname steht jetzt der gesamte Pfad drin, allerdings blau hinterlegt, kann man also mit einem Klick überschreiben.

   
Allerdings übernimmt er nicht den eingestellten Dateityp (jpg) sondern speichert nur den eingegebenen Namen.
   
Könnte ich korrigieren, indem ich die Dateiendung bei Eingabe des Dateinamens mit eingebe, also in diesem Falle „Test.jpg“

[koter]

Hallo Günther,

ein neuer Versuch:

Code:

Sub JPGneuAusAuswahl()
   Dim L As Layer
   Dim ND As Document
   Dim DN As String, DName As String, DPfad As String
   Dim EF As ExportFilter
   If ActiveDocument.Mask.IsEmpty Then
       MsgBox "Keine Maske!", vbCritical, "Fehler"
       Exit Sub
   End If
   DName = Left(ActiveDocument.FileName, Len(ActiveDocument.FileName) - 3) & "jpg"
   DPfad = ActiveDocument.FilePath
   DN = CorelScriptTools.GetFileBox("JPG (*.jpg)|*.jpg", "Datei Speichern", 1, "Neu", ".jpg", DPfad)
   If Trim(DN) = "" Then Exit Sub
   Set L = ActiveDocument.Layers.Add("JPG", , , pntCopySelection)
   L.Cut
   Set ND = Application.CreateDocumentFromClipboard
   ND.Layers.Merge
   Set EF = ND.SaveAs(DN, cdrJPEG)
   EF.Finish
End Sub

Gruß

Koter

[Karthagos]

Hallo Koter,
jetzt ist es perfekt, vielen Dank dafür. Der Vollständigkeit halber nachfolgend nochmal eine Bilderstrecke:
1. Rechteckmaske auf Bild gezogen
   
2. Makro ausgeführt
   
3. Dateinamen mit neuem Namen überschrieben (ohne .jpg-Endung)
   
4. jpg wurde automatisch angefügt
   

Ich denke, das ist auch für den einen oder anderen PhotoPaint-Nutzer interessant.
Nochmals vielen Dank für Deine Mühe.

[Unkraut]

Das JPG Format kann sowieso keine Ebenen bzw Vektorobjekte enthalten, deshalb ist die Warnmeldung in 2019 beim JPG eigentlich überflüssig.
Vielleicht denken die sich bei Corel...... lieber doppelte Sicherheit gerade an kritischen Tagen

Hallo Norre,
die Warnmeldungen kann man doch unter --> Extra --> Optionen seinen Bedürfnissen / Unachtsamkeinten anpassen. Manchmal sind sie nicht ganz so doof, die Corel-Leute.

Liebe Grüße, Chris

[Karthagos]

Hallo Chris,
da muss man auch erst mal drauf kommen. Die meisten Einträge kann ich gar nicht richtig bewerten.
Hab mal alle in PhotoPaint nachfolgend aufgelistet:


Add-ons konnten nicht geladen werden

Autom. Bildspeicherung

Der Farbmodus wird nicht unterstützt.

Effekte können nur auf das aktive Objekt angewendet werden

Export als JPEG 2000

Farben aus der Dokumentpalette werden gelöscht

Layout-Bilder unterliegen Copyright- und Nutzungsbeschränkungen

Linsen zeigen ein dynamisches Verhalten

Löschen von Schriften in Corel Font Manager

Maske wird unverschiebbar gemacht

Objekte mit dem Hintergrund kombinieren

OpenType-Funktionen für vertikalen Text werden nicht unterstützt

PSD-Dateien enthalten Stile auf Ebenen

PSD-Version wird nicht unterstützt

RGB-Farben werden aktualisiert

RIFF-Version wird nicht unterstützt

Rollover müssen sich im Bearbeitungsmodus befinden, um geändert zu werden

Rollover überlappen

Transparenz kann nicht bearbeitet werden

Umformen von Text

Vor Nutzung der Intelligenten Schneidefunktion Objekte mit dem Hintergrund kombinieren

Zurücksetzen der Bildpalette

Zuweisung des Hilfsmittels

Ändern der Inhalte-Speicherorte

Öffnen von Objekten mit Zuschneidemasken im Ausschnitt-Editor

Öffnen von RAW-Dateien

Öffnen von schreibgeschützten Dateien und Verwenden von Hilfsmitteln, die das Auswählen eines Objekts erfordern

 

[koter]

Hallo Günther,

...Was mich lediglich irritiert, ist die Tatsache, dass (inzwischen?) der Speicherpfad C:\Program Files\CorelDRAW\Programs64 vorgeschlagen wird. Liegt das evtl. an der 64bit-Version von Corel. Ich muss dann immer erst den Speicherpfad in den Bereich meiner Arbeitsdateien ändern. Ich meine, das war früher nicht so....

Das sollte (auch früher) nur bei Dateien passieren die nicht gespeichert sind.
Das Makro kann also nicht den Pfad der Datei nutzen, der existiert ja nicht.

Du kannst im Makro einen Pfad für diesen Fall vorgeben:

Code:

Sub JPGneuAusAuswahl()
  Dim L As Layer
  Dim ND As Document
  Dim DN As String, DName As String, DPfad As String
  Dim EF As ExportFilter
  If ActiveDocument.Mask.IsEmpty Then
      MsgBox "Keine Maske!", vbCritical, "Fehler"
      Exit Sub
  End If
  DName = Left(ActiveDocument.FileName, Len(ActiveDocument.FileName) - 3) & "jpg"
  DPfad = ActiveDocument.FilePath

  'Datei nicht gespeichert:
  If Dir(ActiveDocument.FullFileName, vbDirectory) = vbNullString Then DPfad = "c:\temp"

  DN = CorelScriptTools.GetFileBox("JPG (*.jpg)|*.jpg", "Datei Speichern", 1, "Neu", ".jpg", DPfad)
  If Trim(DN) = "" Then Exit Sub
  Set L = ActiveDocument.Layers.Add("JPG", , , pntCopySelection)
  L.Cut
  Set ND = Application.CreateDocumentFromClipboard
  ND.Layers.Merge
  Set EF = ND.SaveAs(DN, cdrJPEG)
  EF.Finish
End Sub

In der Zeile nach dem Kommentar (Datei nicht gespeichert) kannst Du, dort wo jetzt "c:\temp" steht,
einen Pfad Deiner Wahl zwischen die Anführungszeichen schreiben.

Gruß

Koter

P.S.
Auf die PN zu Antworten war nicht möglich.
Er kam die Meldung:
 „Karthagos hat private Nachrichten deaktiviert. Sie können diesem Benutzer keine Nachricht schicken“

[Karthagos]

Hallo Koter, vielen Dank für die Makro-Überarbeitung, so ist es noch perfekter, genial 

Haken bei private Nachrichten empfangen habe ich jetzt gesetzt aber nicht bewusst deaktiviert 

Schönes Wochenende