Re: fortlaufende Nummerierung unterbinden
Sandra
vielleicht hat ja jemand eine Idee, warum dieses Makro bei mir nicht läuft:
Die aller erste Meldung die ich bei Versuch es auszuführen bekomme ist dies hier:
Hier das Makro:
Public Sub PrintSheetsToPDF( _
ByVal SheetsToPrint As Variant, _
ByVal PDFFilePath As String _
)
' Print the specified sheets to a PDF file in the order specified. Requires
' Adobe Acrobat 7.0 and a reference to Acrobat Distiller.
' Syntax
' PrintSheetsToPDF(Sheets, PDFFilePath)
' SheetsToPrint - Array of sheet names to be printed. The sheets included are
' sorted in that order and then printed in one print job. When the printing
' is complete the original order is restored.
' PDFFilePath - Full path to the PDF file.
' Example
' Print sheets "Sheet4", "Sheet10", and "Sheet1" in that order:
' PrintSheetsToPDF Array("Sheet4", "Sheet10", "Sheet1", "C:\Output.PDF")
Dim OriginalActiveWorksheet As Worksheet
Dim OriginalOrderNames As Variant
Dim Index As Long
Dim PDFDistillerApplication As PdfDistiller
Dim TempPFFilePathName As String
Dim PDFLogPathName As String
Dim Result As Long
' Normalize the sheet to print parameter
If Not IsArray(SheetsToPrint) Then SheetsToPrint = Array(SheetsToPrint)
For Index = LBound(SheetsToPrint) To UBound(SheetsToPrint)
If TypeName(SheetsToPrint(Index)) = "Worksheet" Then SheetsToPrint(Index) = SheetsToPrint( _
Index).Name
Next Index
' Normalize the output pdf file name
If LCase(Right(PDFFilePath, 4)) ".pdf" Then PDFFilePath = PDFFilePath & ".pdf"
' Save the current active worksheet
Set OriginalActiveWorksheet = ActiveSheet
' Save the current sheet order
ReDim OriginalOrderNames(1 To ThisWorkbook.Sheets.Count)
For Index = 1 To ThisWorkbook.Sheets.Count
OriginalOrderNames(Index) = ThisWorkbook.Sheets(Index).Name
Next Index
' Reorder the worksheets
For Index = UBound(SheetsToPrint) To LBound(SheetsToPrint) Step -1
If ThisWorkbook.Sheets(SheetsToPrint(Index)).Index > 1 Then
ThisWorkbook.Sheets(SheetsToPrint(Index)).Move Before:=ThisWorkbook.Sheets(1)
End If
Next Index
' Print the worksheets
TempPFFilePathName = Left(PDFFilePath, InStrRev(PDFFilePath, ".")) & "pf"
PDFLogPathName = Left(PDFFilePath, InStrRev(PDFFilePath, ".")) & "log"
On Error Resume Next
Kill TempPFFilePathName
On Error GoTo 0
ThisWorkbook.Worksheets(SheetsToPrint).PrintOut ActivePrinter:="Adobe PDF", PrintToFile:= _
True, Collate:=True, PrToFilename:=TempPFFilePathName
' Restore the original worksheet order
For Index = 1 To ThisWorkbook.Sheets.Count
If ThisWorkbook.Sheets(OriginalOrderNames(Index)).Index Index Then
ThisWorkbook.Sheets(OriginalOrderNames(Index)).Move Before:=ThisWorkbook.Sheets(Index)
End If
Next Index
' Restore the original active worksheet
OriginalActiveWorksheet.Activate
' Convert the postscript file to .pdf
Set PDFDistillerApplication = New PdfDistiller
Result = PDFDistillerApplication.FileToPDF(TempPFFilePathName, PDFFilePath, "")
On Error Resume Next
Kill TempPFFilePathName
If Result = 1 Then Kill PDFLogPathName
End Sub
Ich denke es fehlt der Makroname. Wenn ich aber z. B. Sub PDF_Print_Sheet() in die erste Zeile Schreibe, dann erwarter er ein End Sub
, da ja in der ursprünglich ersten Zeile schon ein Sub steht.Wenn das behoben wird, kommt aber sicher die nächste Fehlermeldung, da das Makro nicht für mich gemacht wurde.
Hat jemand Lust, Zeit und etwas Geduld, mir dabei zu helfen?
@Rainer - DANKE für die tolle Hilfe. Das Du keine Lust mehr hast verstehe ich.
Bis später und liebe Grüß
Sandra