Tabellenblatt automatisch in Ordner abspeichern

Forumthread: Tabellenblatt automatisch in Ordner abspeichern

17.04.2018 16:53:27

neuer

Hallo zusammen,
ich hätte folgende Frage: Ich würde gerne einen Button in einem Tabellenblatt, in dem in Zelle A2 das aktuelle Datum vorhanden ist, hinterlegen und wenn dieser gedrückt wird, wird dieses Tabellenblatt (als Exceldatei weiterhin) in einem Ordner mit folgendem Dateinamen abgespeichert: Name des Tabellenblattes_Datum...Ferner soll der Name des Ordners sich am akutellen Monat orientieren, d.h. wenn das Datum der 17.04.2014 ist soll der Ordner "April 2014" oder wenn das Datum der der 07.06.2016 ist soll der Ordner "Juni 2016" heißen...
Kann mir hier jemand weiterhelfen? Vielen Dank im Voraus!

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

AW: Tabellenblatt automatisch in Ordner abspeichern

18.04.2018 11:06:07

EtoPHG

Hallo Namenloser,
Probier mal (unter der Annahme, dass die Sub-Verzeichnisse unter dem Verzeichnis liegen, in dem die Arbeitsmappe abgespeichert ist) :

Option Explicit
' Diesen Code in ein Standardmodul
Declare Function MakeSureDirectoryPathExists Lib "imagehlp.dll" (ByVal Pfad As String) As Long
'   GetMoreSpeed
Sub GetMoreSpeed(Optional ByVal Modus As Boolean = True)
Static intCalculation As Integer
If Modus = True Then intCalculation = Application.Calculation
With Application
.ScreenUpdating = Not Modus
.EnableEvents = Not Modus
.Calculation = IIf(Modus = True, xlManual, intCalculation)
.Cursor = IIf(Modus = True, 2, -4143)
End With
End Sub

und dann noch so:

Option Explicit
' Diesen Code in das zu kopierende Tabellenblatt mit dem
' ActiveX Steuerelement CommandButton
Private Sub CommandButton1_Click()
Dim sWBName As String
Dim SubPathName As String
Dim NewWBName As String
GetMoreSpeed True
SubPathName = "\" & Format(Cells(2, 1), "MMMM YYYY") & "\"
NewWBName = Me.Name & "_" & Cells(2, 1).Text & ".xlsx"
UsedRange.Copy
MakeSureDirectoryPathExists (ThisWorkbook.Path & SubPathName)
Workbooks.Add
With ActiveWorkbook
With .Worksheets(1)
.Name = Me.Name
.Cells(1, 1).PasteSpecial Paste:=xlPasteValuesAndNumberFormats
.Cells(1, 1).PasteSpecial Paste:=xlPasteFormats
.Cells(1, 1).PasteSpecial Paste:=xlPasteColumnWidths
End With
Application.DisplayAlerts = False
Do While .Worksheets.Count > 1
.Worksheets(2).Delete
Loop
Application.DisplayAlerts = True
sWBName = ThisWorkbook.Path & SubPathName & NewWBName
.SaveAs sWBName
.Close
End With
Application.CutCopyMode = False
MsgBox "Daten gespeichert unter" & vbCrLf & _
sWBName, vbOKOnly + vbInformation
GetMoreSpeed False
End Sub

Gruess Hansueli

AW: Tabellenblatt automatisch in Ordner abspeichern

18.04.2018 17:40:01

neuer

Hi EtoPHG,
danke für deine Antwort das klappt wunderbar...Allerdings ist es so, das ich nach dem ich den Knopf gedrückt habe und das Excel File erstellt wurde, nicht alle Diagramme die im ursprünglichen File vorhanden sind, in dem erstellten Excel File zu sehen bekomme...Woran kann das liegen?
Vielen Dank nochmal!

Von Diagrammen war nicht die Rede...

18.04.2018 18:07:59

EtoPHG

Hallo,
Ich muss wissen, wieviele Diagramme in dem Tabellenblatt liegen.
Gruess Hansueli

Kopieren incl Diagramme als Bild...

19.04.2018 09:09:00

EtoPHG

Hallo neuer,
Ersetzt den Code im Tabellenblatt mit diesem:

Option Explicit
' Diesen Code in das zu kopierende Tabellenblatt mit dem
' ActiveX Steuerelement CommandButton
Private Sub CommandButton1_Click()
Dim sWBName As String
Dim SubPathName As String
Dim NewWBName As String
Dim sh As Shape, lX As Long
GetMoreSpeed True
SubPathName = "\" & Format(Cells(2, 1), "MMMM YYYY") & "\"
NewWBName = Me.Name & "_" & Cells(2, 1).Text & ".xlsx"
UsedRange.Copy
MakeSureDirectoryPathExists (ThisWorkbook.Path & SubPathName)
Workbooks.Add
With ActiveWorkbook
With .Worksheets(1)
.Name = Me.Name
.Cells(1, 1).PasteSpecial Paste:=xlPasteValuesAndNumberFormats
.Cells(1, 1).PasteSpecial Paste:=xlPasteFormats
.Cells(1, 1).PasteSpecial Paste:=xlPasteColumnWidths
' Copy all Charts to the new Worksheet. Omit all other shapes
On Error Resume Next
For Each sh In Me.Shapes
If Left(sh.Name, 6) = "Chart " Then
sh.Copy
.PasteSpecial Format:="Bild (GIF)", Link:=False, DisplayAsIcon:=False
Do While Err.Number  0
Application.Wait (Now + TimeValue("0:00:01"))
Err.Clear
.PasteSpecial Format:="Bild (GIF)", Link:=False, DisplayAsIcon:=False
Loop
lX = lX + 1
.Shapes(lX).Left = sh.Left
.Shapes(lX).Top = sh.Top
End If
Next sh
On Error GoTo 0
Application.CutCopyMode = False
End With
Application.DisplayAlerts = False
Do While .Worksheets.Count > 1
.Worksheets(2).Delete
Loop
Application.DisplayAlerts = True
sWBName = ThisWorkbook.Path & SubPathName & NewWBName
.SaveAs sWBName
.Close
End With
Application.CutCopyMode = False
MsgBox "Daten gespeichert unter" & vbCrLf & _
sWBName, vbOKOnly + vbInformation
GetMoreSpeed False
End Sub

Gruess Hansueli

AW: Kopieren incl Diagramme als Bild...

23.04.2018 11:03:11

neuer

Hi EtoPHG,
vielen Dank für deine Hilfe. Das funktioniert!
Jetzt hätte ich allerdings noch ein Anliegen und zwar habe ich auch mehrere Formen in dem Tabellenblatt, die es beim Drücken des Buttons nicht überträgt...Hast du dafür auch eine Idee?
Vielen Dank nochmal!

Ja Idee und Lösung, aber ....

23.04.2018 11:35:30

EtoPHG

Aber sorry,
Und was kommt, nachher? ...Tropf...Tropf...Tropf...
Für mich macht das Ganze den Anschein, als ob man hier deine Arbeit gratis erledigen sollte.
Das Kopieren von Shapes funktioniert ähnlich wie das von Diagrammen. Das solltest du aus dem Code ableiten können. Kannst du das nicht, dann vergib einen Auftrag an einen VB-Programmierer.
Gruess Hansueli

AW: Ja Idee und Lösung, aber ....

23.04.2018 12:17:48

neuer

Hi EtoPHG,
sorry für das scheibchenweise Liefern der Informationen...Das wäre wirklich das letzte, das ich noch bräuchte! Aber nochmals danke für deine Unterstützung!!

Beliebteste Forumthreads (12 Monate)

Tabellenblatt automatisch in Ordner abspeichern

Forumthread: Tabellenblatt automatisch in Ordner abspeichern

7
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Forumthreads zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Tabellenblatt automatisch in Ordner abspeichern

Forumthread: Tabellenblatt automatisch in Ordner abspeichern

7 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Forumthreads zu verwandten Themen

VBA Beispiele zu diesem und ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

7
Beiträge zum Forumthread

Beiträge zu diesem Forumthread