Tabelle mit festen Namen+Speicherdatum abspeichern
14.03.2017 20:59:29
Andi
Hallo, habe ein kleines Problem mit dem Code. Wollte ihn erweitern, so das noch ein weiteres Sheets zusätzlich mit dem Speicherdatum als .xlsx gleich mit in dem ausgewählten Ordner gespeichert wird. Das Blatt befindet sich mit in der geöffneten Arbeitsmappe.
Sub Speichern_in_PDF_XLSX speichert mir die
Sheets "Tabelle1" mit frei zu vergeben Namen in XLSX und PDF (geht mit dem Code)
u n d (was noch nicht geht)
Sheets "Bearbeiten" mit festen Namen >Bearbeiten+Datum der Speicherung im ausgewählten Verzeichnis.
Habe schon einiges probiert- aber es mag nicht so wie ich es gern hätte.
Problem 2:
Etwas kommt mir merkwürdig vor.
Erstelle ich die Tabelle1 über mein Druckmakro, so wird das Makro "Speichern_in_PDF_XLSX" nicht richtig ausgeführt.(Meldung -es sei nichts zum Drucken vorhanden).
Hebe ich den Druckbereich im Reiter Seitenlayout auf - dann wird alles erstellt.
Das Makro Sub Druckbereich_()
' Hebe Druckbereich auf
Sheets("Tabelle1").Select
ActiveSheet.PageSetup.PrintArea = ""
End Sub
Ist es möglich- dies mit in den Code zu schreiben?
Option Explicit
Public Sub Speichern_in_PDF_XLSX()
Dim varPath As Variant
On Error GoTo Fin
varPath = Application.GetSaveAsFilename( _
InitialFileName:="D:\Elektro Arbeit\", _
FileFilter:="Excel(*.xlsx), *.xlsx", _
Title:="Save as XLSX and PDF")
If Not varPath = False Then
If Dir(varPath) "" Then
Select Case MsgBox("Datei überschreiben?", 4 Or 32 Or 0, "Datei")
Case vbYes
With Application
.ScreenUpdating = False
.DisplayAlerts = False
End With
Sheets("Tabelle1").Copy
With ActiveWorkbook
.SaveAs varPath, 51
.ExportAsFixedFormat Type:=xlTypePDF, Quality:=xlQualityStandard, _
IncludeDocProperties:=True, IgnorePrintAreas:=True
.Close False
End With
End Select
Else
Sheets("Tabelle1").Copy
With ActiveWorkbook
.SaveAs varPath, 51
.ExportAsFixedFormat Type:=xlTypePDF, Quality:=xlQualityStandard, _
IncludeDocProperties:=True, IgnorePrintAreas:=True
.Close False
End With
End If
Else
MsgBox "Abgebrochen..."
End If
Fin:
With Application
.ScreenUpdating = True
.DisplayAlerts = True
End With
If Err.Number 0 Then MsgBox "Fehler: " & _
Err.Number & " " & Err.Description
End Sub
Wie könnte der Code dafür aussehen?
Grüße Andi