Re: PDF
27.03.2003 11:21:24
Holger Meinert
Hallo Peter,
folgendes Makro speichert mir ein Tabellenblatt in ein Verzeichnis meiner Wahl.
Ändere das Makro nach deinen wünsche (Pfad/Name)Sub Ausdruck_in_PDF()
Dim drucker As String, strFile_ps As String, strFile_pdf As String, pfad As String
Dim pdfDist As PdfDistiller
Dim dName$
Dim Zustand As String
dName = "kill"
Worksheets("TBD").Select ' Namen der Tabelle anpassen
drucker = Application.ActivePrinter
Application.ActivePrinter = "Acrobat Distiller auf Ne00:"
Application.DisplayStatusBar = True
Application.StatusBar = "pdf-Dateien werden erstellt...bitte warten!"
Application.ScreenUpdating = False
pfad = Range("M3").Value ' hier wird der Speicherort festgelegt
ChDir Range("M3") 'ändern
Set pdfDist = New PdfDistiller
ActiveSheet.PageSetup.PrintArea = "$A$1:$K$76" ' Druckbereich hier festlegen
strFile_ps = pfad & "\" & dName & ".ps"
strFile_ps = pfad & "\" & dName & ".ps" & "{Enter}"
strFile_pdf = pfad & "\" & Worksheets("TBD").Range("M2").Value & ".pdf" 'in "M2" steht der Name der Datei;("TBD") ist das Tabellenblatt
Application.StatusBar = strFile_pdf & " wird erstellt...bitte warten!"
ChDir Range("M3") 'ändern
If Dir(strFile_pdf) <> "" Then ' hier wir kontrolliert ob die Datei vorhanden ist
box1 = MsgBox("Die Datei ist schon vorhanden !, überschreiben ?", vbYesNo, "Achtung!")
End If
If box1 = vbNo Then
Exit Sub
End If
SendKeys strFile_ps
ActiveWindow.SelectedSheets.PrintOut PrintToFile:=True
strFile_ps = pfad & dName & ".ps"
pdfDist.FileToPDF strFile_ps, strFile_pdf, ""
Application.StatusBar = False
Application.ScreenUpdating = True
ActiveSheet.PageSetup.PrintArea = "$A$1:$K$76"
Application.ActivePrinter = drucker
Zustand = strFile_pdf
If DateiIstFrei(Zustand) = False Then
MsgBox "Datei ist bereits geöffnet !" & vbCr & "Auswertung wird abgebrochen !"
End If
Kill pfad & dName & ".ps" ' die Datei *.ps wird hier gelöscht
End Sub
Function DateiIstFrei(sDateiname As String) As Boolean
Dim hFile As Integer
On Error Resume Next
hFile = FreeFile()
Open sDateiname For Random Access Read Lock Read Write As #hFile
If Err Then
DateiIstFrei = False
Else
DateiIstFrei = True
End If
Close #hFile
End Function