Kleine Äderung eines Speicher-Makros
17.01.2008 15:03:00
Rolf
Es bewirkt, dass die Tabelle3 aus dem Woorkbook "Berichtmanager.xls" als Excel-Datei gespeichert wird.
Wie muss ich es verändern, damit:
- Die gesamte Arbeitsmappe gespeichert wird?
- Im Speicherdialog ein Name vorgegeben wird (z.B. "Sicherung [Heutiges Datum] Notfalls auch "Sicherung1")?
- Ein vorgegebener Pfad angezeigt wird?
Bei meinen besch... eidenen VBA Kentnissen ist dass leider dann doch etwas zu hoch um selbst darauf zu kommen, aber man kann daraus sicher wieder was lernen, wenn man das ganze dann mal wieder auseinander baldovert. :)
Gruss
Rolf
Private Sub CommandButton4_Click()
Dim wbNeu As Workbook, wbAktiv As Workbook
Set wbAktiv = Workbooks("Berichtmanager.xls")
Application.ScreenUpdating = False
Set wbNeu = Workbooks.Add
wbAktiv.Sheets("Tabelle3").Cells.Copy Destination:=wbNeu.Worksheets(1).Cells
'****************************
'HINWEIS EXCEL-SPEICHERDIALOG
'****************************
auswahlangabe1 = MsgBox("Wählen sie im folgenden Dialog den Pfad und den Dateinamen" & _
" für das Excel-File aus", vbOKOnly, "SPEICHERORT EXCEL-FILE")
Saveas_filename = Application.GetSaveAsFilename(InitialFileName:=ActiveWorkbook.Path _
& "\" & strFileSaveName, fileFilter:="MyData(*.xls), *.xls")
'*****************************************
'FALLS ANWENDER AUF ABBRECHEN GEDRÜCKT HAT
'*****************************************
If Saveas_filename = False Then
strTxt = "Sie haben den Speichervorgang abgebrochen. Die Daten wurden nicht exportiert!"
MsgBox strTxt, vbCritical
Exit Sub
End If
'**************
'SPEICHERDIALOG
'**************
wbNeu.SaveAs Filename:=Saveas_filename, FileFormat:=xlNormal, _
Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, _
CreateBackup:=False
'*********************************************
'DATEINAMEN DES BERICHTS IN VARIABLE SPEICHERN
'*********************************************
strFilename = wbNeu.Name
wbNeu.Close
'**************
'ENDANWEISUNGEN
'**************
With wbAktiv
.Activate
.Sheets("Tabelle3").Activate
.Sheets("Tabelle3").Cells.Clear
.Sheets("Tabelle3").Range("A1").Select
.Sheets("Tabelle1").Activate
.Sheets("Tabelle1").Range("A1").Select
End With
Set wbNeu = Nothing: Set wbAktiv = Nothing
'Selection.ClearContents
Range("A1").Select
Application.ScreenUpdating = True
Sheets("Tabelle1").Select
Range("A1").Select