Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
1288to1292
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Excel als PDF speichern
05.12.2012 13:33:40
Meier
Hallo zusammen, ich benötige wohl wieder mal eure hilfe. Ich habe bereits ein bestehendes Makro, welches mir aus einem Excel-File verschiedene Files erstellt mit unterschhiedlichen Registern und immer den aktuellen Speicherort und Dateiname übernimmt.
Leider benötige ich jetzt das gleiche Makro für die Erstellung von PDF's.
Wie bekomme ich die beiden VBA-Makro unter einen Hut?
Vielen Dank für eure stetige Hilfe.
Public Sub AlsPDF()
Sheets(Array("Sheet1", "Shee2"")).Copy
With ActiveWorkbook
.ExportAsFixedFormat Type:=xltyppdf, Filename:="z:\Test.pdf", _
Quality:=xlQualityStandard, _
IncludeDocProperties:=False, IgnorePrintAreas:=False, _
OpenAfterPublish:=False
.Close SaveChanges:=False
End With
End Sub

Public Sub Files_erstellen()
Dim Eingabewert As Byte
Eingabewert = MsgBox("Files erstellen aus Reporting_alle. 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 = "PCO_ST_Reporting_" & strFilenameYear & "_" & strFilenameMonat & "_"
'Nachfrage und Anzeige unterdrücken
Application.DisplayAlerts = False
Application.ScreenUpdating = False
'File1
neudatei = strFilename & "File1" & ".xls"
Set fs = CreateObject("Scripting.FileSystemObject")
fs.CopyFile pfad & "\" & aktdatei, _
pfad & "\" & neudatei, True
Workbooks.Open Filename:=ThisWorkbook.Path & "\" & neudatei
ActiveWorkbook.Worksheets("Register1").Delete
ActiveWorkbook.Worksheets("Register5").Delete
'File2
neudatei = strFilename & "File2" & ".xls"
Set fs = CreateObject("Scripting.FileSystemObject")
fs.CopyFile pfad & "\" & aktdatei, _
pfad & "\" & neudatei, True
Workbooks.Open Filename:=ThisWorkbook.Path & "\" & neudatei
ActiveWorkbook.Worksheets("Register2").Delete
ActiveWorkbook.Worksheets("Register3").Delete
'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
Datum
Anwender
Anzeige
AW: Excel als PDF speichern
05.12.2012 19:46:21
schauan
Hallo Meier,
du stellst den Teil von Witth ... bis End With an die Stelle im langen code, wo die Datei den Zustand hat, wie Du ihn zu speichern wünschst.
Als Dateiname nimmst Du statt
"z:\Test.pdf"
dann z.B.
strFilename & "File1" & ".pdf" oder was da gefordert ist.
Grüße, André
Anzeige

335 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige