Anzeige
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Makro - Speichern unter als PDF
25.03.2013 11:34:45
Meier
Hallo zusammen
Wieder einmal benötige ich Eure super Hilfe. Ich habe ein bestehendes Makro, dass mir aus einer Excel-Datei, verschiedene Excel mit den richtigen Registern ausgibt, sowie korrekte Bennenung.
Jetzt benötige ich das selbe Makro, dass mir aber keine Excel's, sondern PDF's ausgibt.
Besten Dank für die Hilfe, bzw Anpassung meines Makros.
Sub PDF-Files_erstellen()
Dim Eingabewert As Byte
Eingabewert = MsgBox("Files erstellen aus Reporting_alle-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
'Abteilung 1
neudatei = strFilename & "Abteilung1" & ".xlsm"
Set fs = CreateObject("Scripting.FileSystemObject")
fs.CopyFile pfad & "\" & aktdatei, _
pfad & "\" & neudatei, True
Workbooks.Open Filename:=ThisWorkbook.Path & "\" & neudatei
'Verschiebt Register
i = ThisWorkbook.Worksheets.Count
ActiveWorkbook.Sheets("KtLuzern_Quartal").Move After:=Sheets(i)
ActiveWorkbook.Worksheets("Tabelle1").Move After:=Sheets(i)
ActiveWorkbook.Worksheets("Tabelle2").Move After:=Sheets(i)
ActiveWorkbook.Worksheets("Tabelle1").Delete
ActiveWorkbook.Worksheets("Tabelle2").Delete
ActiveWorkbook.Worksheets("Tabelle3").Delete
ActiveWorkbook.Worksheets("Tabelle4").Delete
ActiveWorkbook.Worksheets("Tabelle5").Delete
ActiveWorkbook.Worksheets("Tabelle6").Delete
'ActiveWorkbook.Worksheets("Tabelle7").Delete
'ActiveWorkbook.Worksheets("Tabelle8").Delete
'ActiveWorkbook.Worksheets("Tabelle9").Delete
ActiveWorkbook.Worksheets("Tabelle1").Activate
ActiveWindow.ScrollWorkbookTabs Position:=xlFirst
ActiveWorkbook.Save
ActiveWorkbook.Close
Application.DisplayAlerts = True
Application.ScreenUpdating = True
ActiveWindow.ScrollWorkbookTabs Position:=xlFirst
MsgBox "Alle Files erstellt"
End Sub

2
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Makro - Speichern unter als PDF
25.03.2013 12:39:15
Ralf
Hallo,
baue das nach ActiveWorkbook.Save ein:

ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=ThisWorkbook.Path & "\" & _
left(neudatei,len(neudatei)-5) & ".pdf", Quality:=xlQualityStandard, _
IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=True

OpenAfterPublish:=False, wenn du das anschließend nicht öffnen möchtest
Gruß ralf

AW: Makro - Speichern unter als PDF
25.03.2013 14:23:55
Meier
Besten Dank. Funktioniert wunderbar.
Beste Grüsse
Anzeige

352 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige
Anzeige

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige