Aus Excel-File PDF erstellen

Forumthread: Aus Excel-File PDF erstellen

Meier

Hallo zusammen
Ich brauche wieder einmal heure wertvolle Hilfe. Durch google und sonstige Beiträge habe ich es leide alleine geschafft.
Ich habe ein File mit über 50 Registern. Damit ich die jweiligen Abteilungsfiles erstellen kann, habe ich mir dann ein VBA-Code geschrieben, der einn eues Excel-File generiert mit nur den Abteilungsregistern. Ich sollte aber das selbe noch als PDF haben.
Kann mir jemand helfen, folgendes Makro so umzuschreiben, dass darus PDF's erzeugt werden? Ich benütze den Adobe Acrobat 9 pro.
Vielen Dank für eure Hilfe.

Sub Abteilungsfiles_Erstellen()
Dim Eingabewert As Byte
Eingabewert = MsgBox("Files erstellen aus Reporting_alle-File und nicht aus ursprünglichem  _
File. Weiterfahren?", vbYesNo + vbQuestion)
If Eingabewert = vbNo Then
Exit Sub
End If
'aktuelle Datei
Dim Pfad As String
Dim aktdatei As String
Dim neudatei As String
Dim fs
Pfad = ThisWorkbook.Path
aktdatei = ThisWorkbook.Name
'Jahr, Monat bestimmen
Dim strFilenameYear As String
strFilenameYear = InputBox("Jahr", "", DateTime.Year(DateTime.Now))
Dim strFilenameMonat As String
strFilenameMonat = InputBox("Monat", "", DateTime.Month(DateTime.Now) - 1)
If Len(strFilenameMonat) = 1 Then
strFilenameMonat = "0" & strFilenameMonat
End If
'Dateiname erster Teil setzen
Dim strFilename As String
strFilename = "Reporting_" & strFilenameYear & "_" & strFilenameMonat & "_"
'Nachfrage und Anzeige unterdrücken
Application.DisplayAlerts = False
Application.ScreenUpdating = False
'Test 1 - 3
neudatei = strFilename & "Test1" & ".xls"
Set fs = CreateObject("Scripting.FileSystemObject")
fs.CopyFile Pfad & "\" & aktdatei, _
Pfad & "\" & neudatei, True
Workbooks.Open Filename:=ThisWorkbook.Path & "\" & neudatei
'Verschiebt Blätter Kanton hinter das letzte Sheet
i = ThisWorkbook.Worksheets.Count
ActiveWorkbook.Sheets("KtLuzern_Quartal").Move After:=Sheets(i)
ActiveWorkbook.Worksheets("KtLuzern_Monat").Move After:=Sheets(i)
ActiveWorkbook.Worksheets("Infos").Move After:=Sheets(i)
'ActiveWorkbook.Worksheets("Test1").Delete
'ActiveWorkbook.Worksheets("Test2").Delete
'ActiveWorkbook.Worksheets("Test3").Delete
ActiveWorkbook.Worksheets("Test4").Delete
ActiveWorkbook.Worksheets("Test5").Delete
ActiveWorkbook.Worksheets("Test6").Delete
ActiveWorkbook.Worksheets("Test1").Activate
ActiveWindow.ScrollWorkbookTabs Position:=xlFirst
ActiveWorkbook.Save
ActiveWorkbook.Close
'Test 4 - 6
neudatei = strFilename & "Test4" & ".xls"
Set fs = CreateObject("Scripting.FileSystemObject")
fs.CopyFile Pfad & "\" & aktdatei, _
Pfad & "\" & neudatei, True
Workbooks.Open Filename:=ThisWorkbook.Path & "\" & neudatei
'Verschiebt Blätter Kanton hinter das letzte Sheet
i = ThisWorkbook.Worksheets.Count
ActiveWorkbook.Sheets("KtLuzern_Quartal").Move After:=Sheets(i)
ActiveWorkbook.Worksheets("KtLuzern_Monat").Move After:=Sheets(i)
ActiveWorkbook.Worksheets("Infos").Move After:=Sheets(i)
ActiveWorkbook.Worksheets("Test1").Delete
ActiveWorkbook.Worksheets("Test2").Delete
ActiveWorkbook.Worksheets("Test3").Delete
'ActiveWorkbook.Worksheets("Test4").Delete
'ActiveWorkbook.Worksheets("Test5").Delete
'ActiveWorkbook.Worksheets("Test6").Delete
ActiveWorkbook.Worksheets("Test4").Activate
ActiveWindow.ScrollWorkbookTabs Position:=xlFirst
ActiveWorkbook.Save
ActiveWorkbook.Close
'Nachfrage und Anzeige wieder aktivieren
Application.DisplayAlerts = True
Application.ScreenUpdating = True
ActiveWindow.ScrollWorkbookTabs Position:=xlFirst
MsgBox "Alle Files erstellt"
End Sub

1
Beitrag zum Forumthread

Beitrag zu diesem Forumthread

Betreff

Benutzer

AW: Aus Excel-File PDF erstellen

fcs

AW: Aus Excel-File PDF erstellen

03.07.2012 17:27:42

fcs

Hallo Meier,
in Excel 2010 kannst du direkt PDFs erzeugen ohne den Umweg über Adobe Acrobat.
Aus deinem Code ist nicht ersichtlich wo du jeweils ein PDF erzeugen willst. Ich nehme an, jeweils nach den Save-Anweisungen.
Nachfolgend Beispiel-Code wie du es machen könntest. Die PDF-Ausgabe erfolgt in einer Subroutine an die der Druckauftrag mit Parametern übergeben wird.
Gruß
Franz


Sub Test()
If ActiveWorkbook.Saved = False Then ActiveWorkbook.Save
Call SaveAsPDF(bolAllsheets:=True)
End Sub
Sub Test_a()
If ActiveWorkbook.Saved = False Then ActiveWorkbook.Save
Call SaveAsPDF(varSheets:=Array(1, 3))
'Call SaveAsPDF(varSheets:=Array("Tabelle1", "Tabelle3"))
Sheets(1).Select
End Sub
Public Sub SaveAsPDF(Optional wbk As Workbook, Optional varSheets As Variant, _
Optional bolAllsheets As Boolean = False, Optional PDF_Name As String)
If wbk Is Nothing Then Set wbk = ActiveWorkbook
If bolAllsheets = True Then
If PDF_Name = "" Then
PDF_Name = Left(wbk.FullName, InStrRev(wbk.FullName, ".")) & "pdf"
End If
wbk.ExportAsFixedFormat Type:=xlTypePDF, Filename:=PDF_Name, _
Quality:=xlQualityStandard, IncludeDocProperties:=True, _
IgnorePrintAreas:=False, OpenAfterPublish:=True
Else
If Not IsArray(varSheets) Then
If varSheets = "" Then
varSheets = Array(ActiveSheet.Name)
Else
varSheets = Array(varSheets)
End If
End If
wbk.Sheets(varSheets).Select
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=PDF_Name, _
Quality:=xlQualityStandard, IncludeDocProperties:=True, _
IgnorePrintAreas:=False, OpenAfterPublish:=True
End If
End Sub

Beliebteste Forumthreads (12 Monate)

Forumthread: Aus Excel-File PDF erstellen

1 Beitrag zum Forumthread Beitrag zu diesem Forumthread

Forumthreads zu verwandten Themen

VBA Beispiele zu diesem und ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

1
Beitrag zum Forumthread

Beitrag zu diesem Forumthread