Automatische aktuelle Datumsangabe

[koter]

Hallo Siggi,

...Wäre es dann möglich, das in der Befehlsleiste oben als ICON zum draufklicken zu haben...

Ja, unter: -->Extras-->Optionen-->Anpassung-->Befehle-->Makros
kannst Du Dein Makro in eine Symbolleiste ziehen.
Ein Icon kannst Du dort erstellen oder importieren.
Du kannst auch einen Tastaturbefehl festlegen.

Ich habe mal einen Code gemacht der tut auch das was er soll.
Nur möchte ich eigentlich nicht in das Dialogfeld "Export" sondern in den Dialog "Als PDF ausgeben"...
...Warum tut sich corel mit PublishToPdf so schwer?...

Zwei Bemerkungen vorab:
Dim shape As shape solltest Du nie schreiben!
Shape ist ein Objekttyp und sollte nie als Variable verwendet werden.
Das könnte sich schädlich auswirken!

Du hast die Variable currentDate deklariert, belegt und dann nicht verendet.
Das ist nicht schädlich aber sinnlos.

Der Befehl PublishToPdf erwartet nur einen Parameter, in Deinem Code stehen aber drei.
Das verursacht einen Fehler.

Ich habe Deinen Code geändert, so sollte er funktionieren:

Code:

Sub UpdateDateAndExport2()
   Dim PDFEinst As PDFVBASettings
   Dim currentDate As String, PDFName As String, FormatString As String
   Dim x As Shape
   Dim ds() As String
   
   If Documents.Count < 1 Then Exit Sub 'Abbrechen falls kein Dokument vorhanden ist
   Set PDFEinst = ActiveDocument.PDFSettings
   
   ' Aktuelles Datum im Format "DD.MM.YY"
  currentDate = Format(Date, "DD.MM.YY")
 
  ' Alle Formen im Dokument durchlaufen
  For Each x In ActiveDocument.SelectableShapes
      ' Überprüfen, ob die Form den Namen "DatumHeute" hat
      If x.Name = "DatumHeute" Then
          x.Text.Story = currentDate
          ElseIf Left(x.Name, 10) = "DatumHeute" Then ' Überprüfen, ob der Name der Form mit "DatumHeute" beginnt
          ds = Split(x.Name, "(")
          FormatString = Left(ds(1), Len(ds(1)) - 1)
          x.Text.Story = Format$(Date, FormatString)
          FormatString = ""
      End If
  Next

  ' Dokument speichern
  ActiveDocument.Save
 
  PDFName = DateiDialog
  If PDFName = "" Then Exit Sub 'Abbrechen falls kein Name übergeben wurde
  If Not PDFEinst.ShowDialog Then Exit Sub 'Abbrechen falls Abbrechen gewählt wurde
  ActiveDocument.PublishToPDF PDFName

End Sub

Function DateiDialog() As String
   Dim CST As CorelScriptTools
   Dim CDRN As String, DN As String, RN As String
   Dim Antw
   
   Set CST = CorelScriptTools
   DN = ActiveDocument.Name
   DN = Left(DN, Len(DN) - 3) & "pdf"
   RN = CST.GetFileBox("(PDF)|*.pdf", "Als PDF freigeben", 1, DN)
   If Len(RN) < 1 Then DateiDialog = RN: Exit Function
   If Len(Dir(RN)) > 0 Then
       Antw = MsgBox("Soll die bestehende Datei überschrieben werden?", vbQuestion + vbYesNo, "Datei überschreiben")
       DateiDialog = ""
       If Antw = vbYes Then
           DateiDialog = RN
       End If
   Else
       DateiDialog = RN
   End If
End Function

Ich habe mir erlaubt Deine Kommentare zu korrigieren und zu ergänzen.
Die Funktion DateiDialog legt den Namen für die PDF im Dialog fest.

Falls Du immer die selben Daten verwendest, kannst Du sie auch fest programmieren.
Dann könntest Du Dir einen oder beide Dialoge sparen.

Gruß

Koter

[siggimitbart]

Hey klasse - das funktioniert!
DANKE!


Nun habe ich noch einen Korrekturwunsch.
Das Datum wird nur auf der aktuell geöffneten Seite geändert.
Wir arbeiten allerdings mit Dokumenten mit mehreren Seiten.
Es sollte dann auf allen Seiten gleichzeitig geändert werden.

Ist das möglich?


Vielen Dank!

[koter]

Hallo Siggi,

Mit einer kleinen Ergänzung sollte es möglich sein, alle Seiten zu bearbeiten:

Code:

Sub UpdateDateAndExport3()
   Dim PDFEinst As PDFVBASettings
   Dim currentDate As String, PDFName As String, FormatString As String
   Dim x As Shape
   Dim S As Page
   Dim xR  As ShapeRange, xRall As New ShapeRange
   Dim ds() As String
   
   If Documents.Count < 1 Then Exit Sub 'Abbrechen falls kein Dokument vorhanden ist
   Set PDFEinst = ActiveDocument.PDFSettings
   
   ' Aktuelles Datum im Format "DD.MM.YY"
  currentDate = Format(Date, "DD.MM.YY")
 
  For Each S In ActiveDocument.Pages 'Auf allen Seiten suchen
       Set xR = S.Shapes.FindShapes(Query:="@com.name.StartsWith('DatumHeute')")
       xRall.AddRange xR
  Next
 
  For Each x In xRall
      ' Überprüfen, ob die Form den Namen "DatumHeute" hat
      If x.Name = "DatumHeute" Then
          x.Text.Story = currentDate
          ElseIf Left(x.Name, 10) = "DatumHeute" Then ' Überprüfen, ob der Name der Form mit "DatumHeute" beginnt
          ds = Split(x.Name, "(")
          FormatString = Left(ds(1), Len(ds(1)) - 1)
          x.Text.Story = Format$(Date, FormatString)
          FormatString = ""
      End If
  Next

  ' Dokument speichern
  ActiveDocument.Save

  PDFName = DateiDialog
  If PDFName = "" Then Exit Sub 'Abbrechen falls kein Name übergeben wurde
  If Not PDFEinst.ShowDialog Then Exit Sub 'Abbrechen falls Abbrechen gewählt wurde
  ActiveDocument.PublishToPDF PDFName

End Sub

Falls es mit Deiner Version nicht klappt, melde Dich noch einmal.
Es könnte nützlich sein, Deine Version in der Signatur zu erwähnen.

Gruß

Koter