Moin allerseits!
Ich hab nen kleines Problemchen. Ich habe meine Excel-Tabelle auf einem anderem Rechner kopiert und wollte alles auf Funtion testen. Leider bricht alles ab wenn ich versuche eine Rechnung als PDF speichern zu lassen. Auf meinem Rechner funktioniert alles bestens aber nicht auf dem Rechner wo die Tabelle nun laufen soll.
VBA stoppt bei folgender Zeile mit der Meldung "Fehler beim Kompilieren".
DistillerCall = "C:\Programme\Adobe\Acrobat 6.0\Distillr\Acrodist.exe" & _
~f~
Folges ist dabei blau markiert: DistillerCall!
Auf beiden Rechnern sind die gleichen Versionen des Acrobats installiert, trotz dem funktioniert es nicht. Woran kann das liegen!? Hier mal das gesammt Script:
~f~
&ltpre&gt
Private Sub Drucken_Click()
Dim lngZeile As Long, zz As Long, sp As Long
Dim wsErfass As Worksheet, wsArchiv As Worksheet, wsRechnu As Worksheet
' Set wsErfass = Workbooks("Vati-Rechnung.xls").Sheets("Erfassung-Rech")
' Set wsArchiv = Workbooks("Vati-Rechnung.xls").Sheets("Archiv-Rech")
' Set wsRechnu = Workbooks("Vati-Rechnung.xls").Sheets("Rechnung")
Set wsErfass = ThisWorkbook.Sheets("Erfassung-Rech")
Set wsArchiv = ThisWorkbook.Sheets("Archiv-Rech")
Set wsRechnu = ThisWorkbook.Sheets("Rechnung")
If IsEmpty(wsErfass.Range("B3")) Then
MsgBox "Ohne Anreisedatum wird das nix!", vbCritical
Exit Sub
End If
lngZeile = wsArchiv.Range("A65536").End(xlUp).Row + 1
sp = 1
' B3:B8 nach Spalten A-F
For zz = 3 To 8
wsArchiv.Cells(lngZeile, sp) = wsErfass.Cells(zz, 2)
sp = sp + 1
Next zz
' C8 nach Spalten G
For zz = 8 To 8
wsArchiv.Cells(lngZeile, sp) = wsErfass.Cells(zz, 3)
sp = sp + 1
Next zz
' B9:B15 nach Spalten H-N
For zz = 9 To 15
wsArchiv.Cells(lngZeile, sp) = wsErfass.Cells(zz, 2)
sp = sp + 1
Next zz
' C16 nach Spalten O
For zz = 16 To 16
wsArchiv.Cells(lngZeile, sp) = wsErfass.Cells(zz, 3)
sp = sp + 1
Next zz
' B17 nach Spalten P
For zz = 17 To 17
wsArchiv.Cells(lngZeile, sp) = wsErfass.Cells(zz, 2)
sp = sp + 1
Next zz
' C17 nach Spalten Q
For zz = 17 To 17
wsArchiv.Cells(lngZeile, sp) = wsErfass.Cells(zz, 3)
sp = sp + 1
Next zz
' B18:B26 nach Spalten R-Z
For zz = 18 To 26
wsArchiv.Cells(lngZeile, sp) = wsErfass.Cells(zz, 2)
sp = sp + 1
Next zz
' C22 aus Rechnung nach Spalte AA
For zz = 22 To 22
wsArchiv.Cells(lngZeile, sp) = wsRechnu.Cells(zz, 3)
sp = sp + 1
Next zz
' B29 bis B30 aus Erfassung-Rech nach Spalte AB-AC
For zz = 29 To 30
wsArchiv.Cells(lngZeile, sp) = wsErfass.Cells(zz, 2)
sp = sp + 1
Next zz
' Hier fängt das speichern der Rechnung an als pdf
' Er wechselt zur Rechnung
Sheets("Rechnung").Select
' Festlegen des aktuellen Druckers
Application.ActivePrinter = "Adobe PDF auf Ne06:"
' Definieren der PS und PDF Files
Dim PSFileName As String
Dim PDFFileName As String
Dim wsRechn As Worksheet
Set wsRechn = ThisWorkbook.Sheets("Rechnung")
PSFileName = "D:\Pension\Rechnungen\" & "Rechnung-Sachsenzimmer" & "-" & wsRechn.Range("C22") & ".ps"
If Range("C22").Value &lt&gt "D:\Pension\Rechnungen\" & "Rechnung-Sachsenzimmer" & "-" & wsRechn.Range("C22") & ".pdf" Then
PDFFileName = "D:\Pension\Rechnungen\" & "Rechnung-Sachsenzimmer" & "-" & wsRechn.Range("C22") & ".pdf"
End If
' Druckbereich angeben
Rem Dim wsReser As Worksheet
Dim MySheet As Worksheet
Set MySheet = ActiveSheet
MySheet.Range("A1:H57").PrintOut Copies:=1, Preview:=False, ActivePrinter:="Adobe PDF auf Ne06:", printtofile:=True, Collate:=True, prtofilename:=PSFileName
DistillerCall = "C:\Programme\Adobe\Acrobat 6.0\Distillr\Acrodist.exe" & _
" /n /q /o" & PDFFileName & " " & PSFileName
ReturnValue = Shell(DistillerCall, vbNormalFocus)
If ReturnValue = 0 Then MsgBox "Creation of " & PDFFileName & "failed."
Set pdfDist = Nothing
Rem Kill "D:\Pension\Rechnung\" & "Rechnung-Sachsenzimmer" & "-" & wsReser.Range("D22") & ".log"
Rem Kill "D:\Pension\Rechnung\" & "Rechnung-Sachsenzimmer" & "-" & wsReser.Range("D22") & ".ps"
' Er wechselt zurück zur Erfassung-Reser
Sheets("Erfassung-Rech").Select
' Hier soll die Rechnung gedruckt werden
' Festlegen des aktuellen Druckers weil ja noch Adobe König ist!
Application.ActivePrinter = "Lexmark Optra S 1855 auf Ne04:"
Sheets("Rechnung").Select
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True
Sheets("Erfassung-Rech").Select
Dim trOlApp As New Outlook.Application
Dim trNamespace As Outlook.Namespace
Dim trFolder As Outlook.MAPIFolder
Dim trItem As Outlook.ContactItem
Dim trArre As Worksheet
Dim trReser As Worksheet
Dim trAttachments As Outlook.Attachments
Dim wsReser As Worksheet
Set trNamespace = trOlApp.GetNamespace("MAPI")
Set trFolder = trNamespace.GetDefaultFolder(olFolderContacts).Folders("Pension")
Set trItem = trFolder.Items.Add
Set trAttachments = trItem.Attachments
Set trArre = ThisWorkbook.Sheets("Archiv-Rech")
Set trRech = ThisWorkbook.Sheets("Erfassung-Rech")
Set wsRech = ThisWorkbook.Sheets("Rechnung")
trAttachments.Add ("D:\Pension\Rechnungen\" & "Rechnung-Sachsenzimmer" & "-" & wsRech.Range("C22") & ".pdf")
Rem Stop
With trItem
.FileAs = trRech.Range("B19") & " " & trRech.Range("B18")
.FullName = trRech.Range("B19") & " " & trRech.Range("B18")
.Body = "______________________________________________________________" & Chr(10) & Chr(10) & "NEUER VORGANG ***** " & Date & "-" & Time & " ***** NEUER VORGANG" & Chr(10) & "______________________________________________________________" & Chr(10) & Chr(10) & Chr(187) & " Bemerkung:" & " " & trRech.Range("B26") & Chr(10) & Chr(10) & Chr(187) & " " & "Übernachtung vom: " & trRech.Range("B3") & " bis " & trRech.Range("B4") & " für " & trRech.Range("H5") & " Personen" & Chr(10) & Chr(10) & Chr(187) & " Zahlbetrag: " & trRech.Range("H7") & " Euro" & Chr(10) & Chr(10)
.BusinessAddress = trRech.Range("B21")
.BusinessAddressCity = trRech.Range("B24")
.BusinessAddressPostalCode = trRech.Range("B23")
.BusinessAddressStreet = trRech.Range("B22")
.BusinessFaxNumber = trRech.Range("B30")
.BusinessTelephoneNumber = trRech.Range("B29")
.CompanyName = trRech.Range("B21")
.Email1Address = trRech.Range("B25")
.Email1DisplayName = trRech.Range("B19") & " " & trRech.Range("B18")
.Save
End With
Kill "D:\Pension\Rechnungen\" & "Rechnung-Sachsenzimmer" & "-" & wsRech.Range("C22") & ".log"
Kill "D:\Pension\Rechnungen\" & "Rechnung-Sachsenzimmer" & "-" & wsRech.Range("C22") & ".ps"
End Sub&lt/pre&gt
Bitte, ist echt wichtig - kann mir jemand sagen warum es auf dem einem Rechner perfekt funktioniert, aber auf dem zweitem Rechner nicht.!?
Danke,
Thomas