Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1480to1484
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
Inhaltsverzeichnis

Sicherung unter Namen und mit 2 Zellen

Sicherung unter Namen und mit 2 Zellen
10.03.2016 18:45:43
chris58
Hallo !
Ich bitte um Hilfe. Ich habe ein Makro, mit dem ich Tabellen sichern kann. Geht auch wunderbar. Nur ich möchte noch zusätzlich aus 2 Zellen des Tabellenblattes einmal Text und ein Datum im Sicherungsnamen haben. Wo muss ich das einbauen, bzw. welchen Befehl.
Danke
chris
Hier das Makro:
Sub Speichern()
Dim strDateiname As String
'ggf. Laufwerk und Ordner als Vorgabe setzen
ChDir "C:\Users\Desktop\Trainingslisten\"
ChDrive "c:\"
'Das Dialogfenster, "Monatsliste.xls" als Vorgabedatei
strDateiname = Application.GetSaveAsFilename _
("Monatsliste.xls", "Microsoft Excel-Dateien (*.xls),*.xls")
If TypeName(strDateiname) = "String" Then 'Wenn Dateiname angegeben wurde und mit OK bestä _
tigt :
ActiveSheet.Copy    'Kopiert nur das aktuelle Blatt in eine neue Mappe
Dim shp As Shape
For Each shp In ActiveSheet.Shapes
shp.Delete
Next
ActiveWorkbook.SaveAs strDateiname 'neue Mappe unter eingegebenenm Namen speichern
ActiveWorkbook.Close 'Neue Mappe wieder schliessen
MsgBox "Dateiname :" & vbLf & vbLf & strDateiname, vbOKOnly + vbInformation, "Datei  _
wurde gespeichert :"
End If
'MsgBox "Ihre Auswahl:" & vbNewLine & Dateiname
End Sub

5
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Sicherung unter Namen und mit 2 Zellen
10.03.2016 19:17:04
Rudi
Hallo,
etwa so:
ActiveWorkbook.SaveAs left(strDateiname,len(strDateiname)-4) & "_" & Range("A1") & "_" & Range("A2") & ".xls" 'neue Mappe unter eingegebenenm Namen speichern
Gruß
Rudi

AW: Sicherung unter Namen und mit 2 Zellen
10.03.2016 19:39:32
chris58
Hallo Rudi !
Wenn ich das so einbaue, dann kommt trotz allem nur als Speichername "Monatsliste".
lg
chris
Sub Speichern()
Dim strDateiname As String
'ggf. Laufwerk und Ordner als Vorgabe setzen
ChDir "C:\Users\ch\Sicherung Monatslisten"
ChDrive "c:\"
'Das Dialogfenster, "Monatsliste.xls" als Vorgabedatei
strDateiname = Application.GetSaveAsFilename _
("Monatsliste.xls", "Microsoft Excel-Dateien (*.xls),*.xls")
If TypeName(strDateiname) = "String" Then 'Wenn Dateiname angegeben wurde und mit OK bestä _
tigt :
ActiveSheet.Copy    'Kopiert nur das aktuelle Blatt in eine neue Mappe
Dim shp As Shape
For Each shp In ActiveSheet.Shapes
shp.Delete
Next
ActiveWorkbook.SaveAs Left(strDateiname, Len(strDateiname) - 4) & "_" & Range("A1") & " _
_" & Range("A2") & ".xls" 'neue Mappe unter eingegebenenm Namen speichern
ActiveWorkbook.Close 'Neue Mappe wieder schliessen
MsgBox "Monatsliste " & "wurde gespeichert"
End If
'MsgBox "Ihre Auswahl:" & vbNewLine & Dateiname
End Sub

Anzeige
AW: Sicherung unter Namen und mit 2 Zellen
10.03.2016 22:40:19
Wermer
Hallo Chris,
Sub Speichern()
Dim strDateiname As String
'ggf. Laufwerk und Ordner als Vorgabe setzen
ChDir "C:\Users\Desktop\Trainingslisten\"
ChDrive "c:\"
'Das Dialogfenster, "Monatsliste.xls" als Vorgabedatei
strDateiname = Application.GetSaveAsFilename _
("Monatsliste" & "_" & Range("A1") & "_" & Range("A2") & ".xls", "Microsoft Excel-Dateien (*. _
xls),*.xls")
If TypeName(strDateiname) = "String" Then 'Wenn Dateiname angegeben wurde und mit OK bestätigt : _
ActiveSheet.Copy    'Kopiert nur das aktuelle Blatt in eine neue Mappe
Dim shp As Shape
For Each shp In ActiveSheet.Shapes
shp.Delete
Next
ActiveWorkbook.SaveAs strDateiname 'neue Mappe unter eingegebenenm Namen speichern
ActiveWorkbook.Close 'Neue Mappe wieder schliessen
MsgBox "Dateiname :" & vbLf & vbLf & strDateiname, vbOKOnly + vbInformation, "Datei wurde  _
gespeichert :"
End If
'MsgBox "Ihre Auswahl:" & vbNewLine & Dateiname
End Sub
Gruß Werner

Anzeige
AW: Sicherung unter Namen und mit 2 Zellen
11.03.2016 07:53:36
chris58
Hallo !
Danke, das geht nun perfekt
chris

AW: Danke für die Rückmeldung. o.w.T
11.03.2016 09:10:41
Wermer

299 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige