AW: pdf ansprechen
12.04.2008 15:24:49
Tino
Hallo,
ich mache es mit dem PDFCreator, gib es als Freeware im Internet.
Beispiel: http://www.pdfforge.org/products/pdfcreator
Nach der Installation im VBA Editor unter Extras Verweise den PDFCreator einbinden
Der Code zum erstellen:
Sub Speichern_PDF()
Dim pdfjob As PDFCreator.clsPDFCreator
Dim sPDFName As String
Dim sPDFPath As String
sPDFPath = GetDirectory("Wählen sie einen Speicherort")
If sPDFPath = "" Then Exit Sub
If Right$(sPDFPath, 1) "\" Then sPDFPath = sPDFPath & "\"
sPDFName = "MeinPDF_" & Format(Now, "dd-mm-yyyy hh-mm") & ".pdf"
If IsEmpty(ActiveSheet.UsedRange) Then Exit Sub
Set pdfjob = New PDFCreator.clsPDFCreator
With pdfjob
If .cStart("/NoProcessingAtStartup") = False Then
MsgBox "Can't initialize PDFCreator.", vbCritical + _
vbOKOnly, "PrtPDFCreator"
Exit Sub
End If
.cOption("UseAutosave") = 1
.cOption("UseAutosaveDirectory") = 1
.cOption("AutosaveDirectory") = sPDFPath
.cOption("AutosaveFilename") = sPDFName
.cOption("AutosaveFormat") = 0 ' 0 = PDF
.cClearCache
End With
ActiveSheet.PrintOut copies:=1, ActivePrinter:="PDFCreator"
Do Until pdfjob.cCountOfPrintjobs = 1
DoEvents
Loop
pdfjob.cPrinterStop = False
Do Until pdfjob.cCountOfPrintjobs = 0
DoEvents
Loop
pdfjob.cClose
Set pdfjob = Nothing
End Sub
Die Funktion für Ordnerauswahl, am besten in ein eigenen Modul einfügen:
Declare Function SHGetPathFromIDList Lib "shell32.dll" _
Alias "SHGetPathFromIDListA" _
(ByVal pidl As Long, ByVal pszPath As String) As Long
Declare Function SHBrowseForFolder Lib "shell32.dll" _
Alias "SHBrowseForFolderA" (lpBrowseInfo As BROWSEINFO) As Long
Public Type BROWSEINFO
hOwner As Long
pidlRoot As Long
pszDisplayName As String
lpszTitle As String
ulFlags As Long
lpfn As Long
lParam As Long
iImage As Long
End Type
'Ruft das Dialogfeld zur Ordnerauswahl auf
Function GetDirectory(Msg) As String
Dim bInfo As BROWSEINFO
Dim path As String
Dim r As Long, x As Long, pos As Integer
With bInfo
.pidlRoot = 0&
.lpszTitle = Msg
.ulFlags = &H1
End With
x = SHBrowseForFolder(bInfo)
path = Space$(512)
r = SHGetPathFromIDList(ByVal x, ByVal path)
If r Then
pos = InStr(path, Chr$(0))
GetDirectory = Left(path, pos - 1)
Else
GetDirectory = ""
End If
End Function
Gruß
Tino