Tabellenblätter einzeln in variablen Pfad speicher

Informationen und Beispiele zu den hier genannten Dialog-Elementen:
MsgBox
Bild

Betrifft: Tabellenblätter einzeln in variablen Pfad speicher
von: Gerwin
Geschrieben am: 24.06.2015 20:46:29

Hallo Liebes Forum,
ich hab mir schon die Finger wund getippt auf einer Suche nach einer passenden Lösung für mein Problem:
Ich habe eine Arbeitsmappe mit 6 Blättern von denen auf Knopfdruck 4 einzeln gespeichert werden sollen in einem Pfad den man z.B. über den "Speichern unter" Dialog bestimmt.
Bislang speicher ich die Dokumente einzeln ab was bei häufiger anwendung unkomfortabel ist ( _
hier der Code dazu):


Private Sub Image1_Click()
With Sheets("Gelangensbestätigung")
        .Visible = True
        .Copy
        .Visible = False
End With
ActiveSheet.UsedRange.Cells = ActiveSheet.UsedRange.Cells.Value
  'Code
  'Zeigt einen Dateiauswahl-Diaog zum Speichern an
  With Application.FileDialog(msoFileDialogSaveAs)
    .Title = "Speichern unter"
    .InitialFileName = "C:\Users\Maximillian\AKTUEL.\2015 -RG\" & Cells(53, 1) & " " & " _
Gelangensbestätigung" & " " & Cells(30, 9) & " " & Cells(31, 9) & " " & Format(Now, "YYYYMMDD")
    If .Show = False Then
      MsgBox "Datei wurde nicht gespeichert!"
    Else
      .Execute
    End If
  End With
    Windows("Exportdokumentenerstellung_AUTOMOBILE.xlsm").Activate
    
End Sub

Ich hoffe jemand von euch kann mir helfen.
Grüße und ein Schönen Abend
Gerwin

Bild

Betrifft: AW: Tabellenblätter einzeln in variablen Pfad speicher
von: Sepp
Geschrieben am: 24.06.2015 21:00:04
Hallo Gerwin,
wie heißen die Blätter vorher und wie soll die Datei dann jeweils heißen?
Soll für jedes Blatt der Dialog für den Dateinamen erscheinen, oder soll man nur den Pfad auswählen?

Gruß Sepp


Bild

Betrifft: AW: Tabellenblätter einzeln in variablen Pfad speicher
von: da.ricci
Geschrieben am: 25.06.2015 03:45:05
Hallo Gerwin,
mit Auswahl über VBA:

Sub Tabellenblätter_einzeln_in_variablen_Pfad_speichern()
Dim Ordnerpfad As String, strDateiname As String, strPfad As String
Dim myDialog As Object, wsBlatt As Worksheet, BlattAuswahl As String
' == hier die Blätter auswählen als Tabellen(index)
BlattAuswahl = Sheets(Array(2, 4, 6)).Select
' == ader als Tabelle.Name
'BlattAuswahl = Sheets(Array("Tabelle2", "Tabelle3", "Tabelle5")).Select
' == aktueller Pfad von Quelldatei
strPfad = ActiveWorkbook.Path & "\"
' == Speichername
strDateiname = Cells(53, 1) & " Gelangensbestätigung " & Cells(30, 9) & _
                " " & Cells(31, 9) & " " & Format(Now, "YYYYMMDD")
Set myDialog = Application.FileDialog(msoFileDialogFolderPicker)
 With myDialog
  .Title = "Speicherordner auswählen"
      ' == Vorgabe Speicherpfad
  .InitialFileName = " %USERPROFILE%\My Documents\" ' == oder:"D:\" oder:"\\Netzlaufwerk\"
      ' == oder Vorgabe: aktueller Pfad von Quelldatei
' .InitialFileName = strPfad
      If .Show = -1 Then
         Ordnerpfad = .SelectedItems(1)
           MsgBox Ordnerpfad 'Zur Info
          For Each wsBlatt In ThisWorkbook.Windows(1).SelectedSheets
             wsBlatt.Copy
             ActiveWorkbook.SaveAs Filename:=Ordnerpfad & "\" & ActiveSheet.Name, _
             FileFormat:=xlOpenXMLWorkbook ' = .xlsx
             ActiveWorkbook.Close
          Next wsBlatt
      End If
 End With
End Sub
Oder händisch Tabellenblätter markiern (zuerst Blätter markieren - dann Macroaufruf)
und den Blattauswahl-Code entfernen:

' === hier die Blätter auswählen als Tabellen(index)
BlattAuswahl = Sheets(Array(2, 4, 6)).Select
....
....

Grüße
da.ricci

Bild

Betrifft: AW: Tabellenblätter einzeln in variablen Pfad speicher
von: Gerwin
Geschrieben am: 25.06.2015 08:37:24
Guten Morgen Sepp,
da.riccis Antwort scheint schon die Lösung. Danke trotzdem :)
(Die Namen der Tabellen/Dateien werden aus den Zellen gezogen

strDateiname = Cells(53, 1) & " Gelangensbestätigung " & Cells(30, 9) & _
                " " & Cells(31, 9) & " " & Format(Now, "YYYYMMDD")

Guten Morgen da.ricci
vielen vielen Dank. Du hast mir super geholfen. Habe es eben auf einer Blanko Arbeitsmappe ausgetestet, scheint genau das zu sein was ich brauch. Zuhause probier ichs dann nochmal in der richtigen Datei, aber scheint perfekt zu sein. Vielen Dank auch für die Kommentare im Code, ist für einen dessen VBA Kenntnisse zu 90% nur aus "basteln" bestehen, sehr hilf- und lehrreich.
Ein schönen Tag erstmal noch.
Gerwin :)

Bild

Betrifft: AW: Tabellenblätter einzeln in variablen Pfad speicher
von: da.ricci
Geschrieben am: 25.06.2015 09:37:42
Hallo Gerwin,
nicht weitersagen - bin auch nur ein "Bastler" - der sich gelegentlich mit VBA auseinandersetzt.
und habe mir deshalb auch all meinen Code kommentiert, damit ich nach "Jahren" noch weis, was ich
"damals" machte, warum und wie - oder "etwas ähnliches brauche". ;-)
auch einen schönen Tag
da.ricci

Bild

Betrifft: AW: Tabellenblätter einzeln in variablen Pfad speicher
von: Gerwin
Geschrieben am: 25.06.2015 11:49:23
Hallo da.ricci
Sollte ich mir auch angewöhnen. Ich steh oft vor alten Sachen und denk mir "hä"? :D
Vielleicht könntest du mir noch bei 2 dingen helfen,
wenn in dem Ausgewählten Zielordner die Datei bereits vorhanden ist, und man dann nach der "soll die vorhandene Datei überschrieben werden" auf nein klickt kommt ein Fehler dass die SaveAs Methode fehlgeschlagen ist.
Hier würde was simples reichen, entweder soll er einfach weitermachen oder die Abfrage gar nicht stellen und überschreiben, je nachdem was einfacher ist. Ich habs mit On Error probiert hat aber nicht geklappt..

             On Error GoTo Naechste
             wsBlatt.Copy
             ActiveWorkbook.SaveAs Filename:=Ordnerpfad & "\" & ActiveSheet.Name & strDateiname, _
 _
             FileFormat:=xlOpenXMLWorkbook ' = .xlsx
             ActiveWorkbook.Close
Naechste:              Next wsBlatt
Das 2. wäre (ist nicht zwingend notwendig, nur elegant) Kann man die das Auswählen der Blätter auch ohne die Select Methode durchführen?
BlattAuswahl = Sheets(Array("T1", "T2", "T3", "T4")).Select
Die Blätter sind Ausgeblendet, blende sie zur zeit über visible und hide ein und aus für das makro. Vielleicht hast du ja ne elegantere Lösung.
Gruß
Gerwin

Bild

Betrifft: AW: Tabellenblätter einzeln in variablen Pfad speicher
von: da.ricci
Geschrieben am: 26.06.2015 21:19:46
Hallo Gerwin,
sorry, Fehlerteufel :- heisst natürlich nicht "ActiveSheet.Name" im Code, sonder, wie du richtig gemerkt hast "strDateiname"
>> wenn in dem Ausgewählten Zielordner die Datei bereits vorhanden ist ....
du könntest (spätestens) nach:


    wsBlatt.Copy
ein:
    Application.DisplayAlerts = False 'schaltet Fehlerüberprufüng aus
     .....
und (frühestens) nach:
    ActiveWorkbook.Close
ein:
   Application.DisplayAlerts = True 'schaltet Fehlerüberprufüng wieder ein
     .....
einfügen - dann würden schon vorhandene Dateien überschrieben werden.
Macht meist wenig Sinn bzw. ist selten erwünscht ;-)
Hier wäre es besser, den Dateinamen um eine "wirklich eindeutige" Variable zu erweitern
à la Cells(31, 9) oder Format(Now, "YYYYMMDD hh-mm-ss")
Problem ist das Excel so "sauschnell" ist dass, der Speichervorgang von einem Blatt bis nächsten Blatt nur ein "Zwinkern" dauert.
Da müsste man noch ein:

   Application.Wait (Now + TimeValue("0:00:1")) ' warte 1 Sekunde
vor:
   Next wsBlatt ' mache weiter
Eleganter wäre, statt Sekunden zu warten und zählen - à la "Windows-Funtion" den Dateinamen um (index) zu erweitern. (Dateiname.xlsx, Dateiname_1.xlsx, Dateiname_2xlsx, ....)
>> ... das Auswählen der Blätter auch ohne die Select Methode ......
Naja - du wolltest: 4 von 6 Blättern - die müßt du irgendwie auswählen. ;-)
Ich denke mal 2 Blätter Visible - nicht kopieren - 4 Blätter Hidden - kopieren
Dann ungefähr so
- Worksheet.xlSheetVisible wird nichr kopiert
- Fehler: Datei schon vorhanden wird mit - "Windows-Dubletten-Format" korrigiert:
Sub Tabellenblätter_einzeln_in_variablen_Pfad_speichern_vers2()
Dim Ordnerpfad As String, strDateiname As String, strPfad As String
Dim myDialog As Object, wsBlatt As Worksheet, BlattAuswahl As String, i As Integer
' == aktueller Pfad von Quelldatei
strPfad = ActiveWorkbook.Path & "\"
' == Speichername
strDateiname = Cells(53, 1) & " Gelangensbestätigung " & Cells(30, 9) & _
                " " & Cells(31, 9) & " " & Format(Now, "yyyymmdd")
Set myDialog = Application.FileDialog(msoFileDialogFolderPicker)
 With myDialog
  .Title = "Speicherordner auswählen"
      ' == Vorgabe Speicherpfad
  .InitialFileName = " %USERPROFILE%\My Documents\" ' == oder:"D:\" oder:"\\Netzlaufwerk\"
      ' == oder Vorgabe: aktueller Pfad von Quelldatei
' .InitialFileName = strPfad
      If .Show = -1 Then
         Ordnerpfad = .SelectedItems(1)
'           MsgBox Ordnerpfad 'Zur Info
       For Each wsBlatt In ThisWorkbook.Worksheets
     Application.ScreenUpdating = False '== Bildschirm Aktualisierung abschalten
     Application.DisplayAlerts = False  '== Fehlermeldung abschalten
'         MsgBox wsBlatt.Name & " XlSheetVisibility ist: " & wsBlatt.Visible  'Zur Info
         If wsBlatt.Visible = xlSheetHidden Then
           With wsBlatt
             .Visible = xlSheetVisible
             .Copy
             If i = 0 Then ' == "normaler" Speichername
                 ActiveWorkbook.SaveAs Filename:=Ordnerpfad & "\" & strDateiname, _
                 FileFormat:=xlOpenXMLWorkbook ' = .xlsx
             Else ' == i > 0  Speichername im "Windows-Dubletten-Format": Dateiname_1.*
                 ActiveWorkbook.SaveAs Filename:=Ordnerpfad & "\" & strDateiname & "_" & i, _
                 FileFormat:=xlOpenXMLWorkbook ' = .xlsx
             End If
             ActiveWorkbook.Close
             ThisWorkbook.Activate ' == QuellMappe von "Macro-Auftuf" aktivieren
             .Visible = xlSheetHidden ' == und das Blatt wieder verstecken
           i = i + 1
          End With
        ElseIf wsBlatt.Visible = xlSheetVeryHidden Then
          With wsBlatt
           .Visible = xlSheetVisible
           .Copy
             If i = 0 Then
                 ActiveWorkbook.SaveAs Filename:=Ordnerpfad & "\" & strDateiname, _
                 FileFormat:=xlOpenXMLWorkbook ' = .xlsx
             Else
                 ActiveWorkbook.SaveAs Filename:=Ordnerpfad & "\" & strDateiname & "_" & i, _
                 FileFormat:=xlOpenXMLWorkbook ' = .xlsx
             End If
           ActiveWorkbook.Close
           ThisWorkbook.Activate
           .Visible = xlSheetVeryHidden
           i = i + 1
         End With
        Else
              'nichts
        End If
      Next wsBlatt
    Application.ScreenUpdating = True  ' == Bildschirm Aktualisierung einschalten
    Application.DisplayAlerts = True   ' == Fehlermeldung einschalten
   End If
End With
End Sub

Wobei, bei nochmaligen Aufruf von Macro werden die Dateien, sehr wohl überschrieben.
Das würde sich nur über eine "Dir-Abfrage" lösen lassen - dafür hab ich im Moment keine Lösung ;-)
Aber siehe mal: https://www.herber.de/mailing/vb/html/vafctdir.htm zur Info
(muss ich mich da auch erst einarbeiten)
Grüsse
da.ricci
schönes WE - muß mal "kurz" nach: http://www.vienna.at/specials/donauinselfest

 Bild

Beiträge aus den Excel-Beispielen zum Thema "Tabellenblätter einzeln in variablen Pfad speicher"