1
Word / Antw:Office 2010: Veröffentlichen als pdf - Makro - Überschirften als Textmarke
« am: Juni 22, 2016, 16:12:58 Nachmittag »
Hallo,
vielen Dank für den Tipp.
Habe es wie folgt in Word umgesetzt:
vielen Dank für den Tipp.
Habe es wie folgt in Word umgesetzt:
Code: [Auswählen]
Option Explicit
'Dateiname des zu exportierenden Dokumentes
Public strExportDokument As String
Sub DokumentAlsPdfSpeichern()
'speichert das aktuelle Dokument als pdf
'Ordner wird manuell ausgewählt
'DokumentName wird über UserForm abgefragt
'Überschriften werden als Lesezeichen gesetzt
Dim strOrdner As String
Dim strDateiname As String
Dim strOrdnerDateinameDokument As String
On Error GoTo Error
'Pfad ermitteln
With Application.FileDialog(msoFileDialogFolderPicker)
.InitialFileName = "X:"
.Title = "Ordnerauswahl"
.ButtonName = "Ordner wählen"
.InitialView = msoFileDialogViewList
If .Show = -1 Then
strOrdner = .SelectedItems(1)
'ggf. Backslash am Ende weg
If Right(strOrdner, 1) = "\" Then strOrdner = Left(strOrdner, Len(strOrdner)) - 1
strDateiname = StrReverse(strOrdner)
strDateiname = Mid(strOrdner, Len(strDateiname) - InStr(1, strDateiname, "\", vbTextCompare) + 2)
'Backslah hinzufügen
strOrdner = strOrdner & "\"
Else
strOrdner = ""
End If
End With
'prüfen: Ordner gewählt, Bezeichnung Ordner beginnt mit Datum?
If strOrdner = "" Or Not IsDate(Left(strDateiname, 10)) Then
MsgBox "Kein Ordner gewählt oder der gewählte Ordner entspricht nicht dem Format der Sitzungsordner (Dateiname beginnend mit Datum 'JJJJ-MM-TT'))!" & vbCrLf & vbCrLf & _
"Dokument wurde nicht exportiert!", vbCritical, "Fehler bei Ordnerwahl"
Else
'Dokumentvorgabe löschen
strExportDokument = ""
'Dokument wählen
UserForm_DokumentWaehlen.Show
'prüfen: Dokument gewählt?
If strExportDokument = "" Then
MsgBox "Kein Dokument gewählt! Dokument wurde nicht exportiert!", vbCritical, "Kein Dokument gewählt"
Else
'zusammengesetzter Pfad mit Dateinamen inkl Dokument
strOrdnerDateinameDokument = strOrdner & strDateiname & " - " & strExportDokument
'prüfen: Dokument vorhanden?
If Dir(strOrdnerDateinameDokument & ".pdf", vbDirectory) = "" Then
'nein > speichern
ActiveDocument.ExportAsFixedFormat outputfilename:=strOrdner & strDateiname & " - " & strExportDokument, ExportFormat:=wdExportFormatPDF, CreateBookmarks:=wdExportCreateHeadingBookmarks
'Info & Abfrage: öffnen?
If MsgBox("Das Dokument " & strExportDokument & " wurde gespeichert." & vbCrLf & vbCrLf & _
"Soll das Dokument geöffnet werden?", vbYesNo + vbQuestion, "Gespeichertes Dokument öffnen?") = vbYes Then _
Shell "Explorer.exe """ & strOrdnerDateinameDokument & ".pdf" & """", vbNormalFocus
Else
'ja > Abfrage: überschreiben?
If MsgBox("Das Dokument " & strExportDokument & " ist schon vorhanden. Soll das Dokument überschrieben werden?", _
vbYesNo + vbQuestion, "Dokument überschreiben?") = vbYes Then
'ja > speichern
ActiveDocument.ExportAsFixedFormat outputfilename:=strOrdner & strDateiname & " - " & strExportDokument, ExportFormat:=wdExportFormatPDF, CreateBookmarks:=wdExportCreateHeadingBookmarks
'Info & Abfrage: öffnen?
If MsgBox("Das Dokument " & strExportDokument & " wurde gespeichert." & vbCrLf & vbCrLf & _
"Soll das Dokument geöffnet werden?", vbYesNo + vbQuestion, "Gespeichertes Dokument öffnen?") = vbYes Then _
Shell "Explorer.exe """ & strOrdnerDateinameDokument & ".pdf" & """", vbNormalFocus
Else
MsgBox "Dokument wurde nicht exportiert!", vbCritical, "Dokument nicht exportiert"
End If
End If
End If
End If
Exit Sub
Error:
MsgBox "Fehler. Dokument wurde nicht exportiert!", vbCritical, "Fehler"
End Sub