02.03.2012

16719

Excel VBA - Tabelle per Button-Klick abspeichern. Speichername setzt sich aus einem Text und einem Zellinhalt zusammen.

Moin,

ich habe ein commandbutton der nach dem Klick die Arbeitsmappe abspeichern soll. Dies funktioniert schon... allerdings möchte ich, dass der Speichername sich aus einem Text (nämlich "000") und einer Vorgangsnr. (befindet sich in G30) zusammensetzt.

Also nach dem Klick des Buttons (wenn die Vorgangsnr. z.B. 12 ist) wird die Tabelle als 00012.xlsm in einem Unterordner (Unterordner heisst = Vorgänge) abgespeichert.

Hier mein bisheriger Code... den hab ich aus verschiedenen Codes die ich im Netz gefunden habe zusammengebastelt...
Es öffnet sich zwar das Fenster zum abspeichern, aber es wird mein definierter Text als Speichername nicht angezeigt. Zusätzlich fehlt die Funktion mit dem Unterordner komplett.

Private Sub button2_Click()
ActiveSheet.Unprotect
'Variablen deklarieren  
Dim var1 As String
Dim var2 As String
fileSaveName = Application.GetSaveAsFilename( _
    fileFilter:="Microsoft Office Excel-Arbeitsmappe (*.xlsm), *.xlsm")  

If fileSaveName = False Then
        'wenn im Dialogfeld auf Abbrechen geklickt wurde...  
    MsgBox "Vorgang wurde abgebrochen !" & vbCr & _  
            "Datei wurde NICHT gespeichert       ", _  
            vbOKOnly, "Achtung....."  
Else
   'Werte aus den Zellen auslesen  
    var1 = "000"  
    var2 = Tabelle1.Cells(7, 30)
    'Arbeitsmappe unter dem zusammengesetzten Dateinamen speichern  
    ThisWorkbook.SaveAs var1 & "_" & var2 & ".xlsm"  
End If
ActiveSheet.Protect
End Sub

Ich hoffe jemand kann mir helfen...

Grüße

Amiga500

Bitte markiere auch die Kommentare, die zur Lösung des Beitrags beigetragen haben

Content-ID: 181332

Url: https://administrator.de/contentid/181332

Ausgedruckt am: 23.11.2024 um 01:11 Uhr

13 Kommentare

Neuester Kommentar

Habe nur kurz draufgeschaut. Kann es sein das Du den öffnen Dialog ansprichst bevor Du den Namen ermittlst. Müsste das nicht hinterher geschehen?

Hab es jetzt mal geändert:

Jetzt liest er die variable 1 zwar aus aber er scheint probleme mit der zweiten variable zu haben... die dateien heissen jetzt 000.xlsm

Müssten aber 000+vorgangsnummer in der Zelle G32 heissen, also z.B. 00012.xlsm

Die Zelle mit der Vorgangsnummer ist jetzt G32, weil ich die Tabelle noch etwas angepasst habe...

Jemand eine Idee warum er die Zelle G32 nicht ausliest?
Und wie kann ich ihm sagen, dass er die Dateien in einem Unterordner "Vorgänge" abspeichern soll?

Private Sub button2_Click()
ActiveSheet.Unprotect
'Variablen deklarieren  
Dim var1 As String
Dim var2 As String
'Werte aus den Zellen auslesen  
    var1 = "000"  
    var2 = Tabelle1.Cells(7, 32)
    'Arbeitsmappe unter dem zusammengesetzten Dateinamen speichern  
    ThisWorkbook.SaveAs var1 & var2 & ".xlsm"  

If fileSaveName = False Then
        'wenn im Dialogfeld auf Abbrechen geclickt wurde...  
    MsgBox "Vorgang wurde abgebrochen!" & vbCr & _  
            "Datei wurde nicht gespeichert       ", _  
            vbOKOnly, "Achtung!"  

End If
ActiveSheet.Protect
End Sub

Danke euch...

Grüße

Amiga500

Hallo Amigaa500

probier mal die Zeile 08 durch

var2 = Range("G32").Value

zu ersetzen

Mit deiner Ordnergeschichte könntest du circa so vorgehen
(was zum spielen)

NeuerOrdner = "Vorgaenge"  

Set FSO = CreateObject("Scripting.FileSystemObject")  

if not FSO.Folderexists (NeuerOrdner) then
	Set OrdnerPfadNeu = FSO.CreateFolder(NeuerOrdner)
End If

Gruss
Tsuki

Vielen Dank

Das Abspeichern funktioniert jetzt...
Die Sache mit dem Unterordner schau ich mir Montag mal an.... (hab gleich Feierabend ;))

der speichert die Dateien momentan auch im Standard Dokument Ordner (Bibliotheken\Dokumente) und wechselt beim abspeichern auch gleich auf die gerade gespeicherte Tabelle. Das soll er auch nicht machen. Nach dem Klick des Buttons soll er trotzdem noch in der ursprünglichen Excel Tabelle bleiben.

Der Code sieht übrigens jetzt so aus:

Private Sub button2_Click()
ActiveSheet.Unprotect
Dim var1 As String
Dim var2 As String
    var1 = "000"  
    var2 = Range("G32").Value  
    ThisWorkbook.SaveAs var1 & var2 & ".xlsm"  
ActiveSheet.Protect
End Sub

Da muss jetzt nur noch der Code für den Unterordner rein... und die Funktion, dass er beim Abspeichern in der ursprünglichen Tabelle bleibt und nicht auf die neue wechselt (00012.xlsm). Speichern soll er die Datei in der gleichen Ordnerstruktur wo die Ursprungsdatei liegt. Dort soll er ein Unterordner erstellen bzw in diesen wechseln und die Dateien beim Buttonklick speichern.

Euch ein schönes Wochenende und nochmals vielen Dank

Grüße

Amiga500

Bevor du ins Wochenende gehst vielleicht noch das hier

Nach dem Klick des Buttons soll er trotzdem noch in der ursprünglichen Excel Tabelle bleiben.

das ginge eventuell mit

Windows("MeineUrspruenglicheExcelTabelle").Activate  
' dann das Abspeichern  
ActiveSheet.Unprotect
Dim var1 As String
Dim var2 As String
    var1 = "000"  
    var2 = Range("G32").Value  
    ThisWorkbook.SaveAs var1 & var2 & ".xlsm"  
ActiveSheet.Protect 

Schönes WE

Tsuki

Also ich hab's nochmal als funktionierendes Beispiel in einem Testcode zusammengefasst

Private Sub CommandButton1_Click()
Windows("Mappe1").Activate  
Dim var1 As String
Dim var2 As String
    var1 = "000"  
    var2 = Range("G32").Value  
    NeuerOrdner = "Vorgaenge"  
    Set FSO = CreateObject("Scripting.FileSystemObject")  
    If Not FSO.Folderexists(NeuerOrdner) Then
        Set OrdnerPfadNeu = FSO.CreateFolder(NeuerOrdner)
    End If
    ThisWorkbook.SaveAs NeuerOrdner & "\" & var1 & var2 & ".xls"  
End Sub

Bei Mappe1 muss nur rein, wie deine Exceldatei heisst (Bsp.: Meine.xls -> dann Meine) etc.

Gruss
Tsuki

Hallo TsukiSan,

ich hoffe du hattest ein schönes WE

vielen Dank nochmal für deine Mühe.

Es funktioniert jetzt alles, außer das er nach dem Abspeichern in der ursprünglichen Excel Datei bleibt. Nachdem ich auf den Speicherbutton klicke, springt er dann sofort auf die neue 0004.xlsm (bzw. je nach vorgangsnummer heisst die datei anders)

Er soll aber im Änderungsantrag.xlsm bleiben, damit man bei Bedarf noch mehr Anträge bearbeiten bzw speichern kann.

Vielleicht weisst du zu diesem Problem ja auch eine Lösung oder evtl. kann jemand anderes helfen?

Private Sub button2_Click()
Windows("Änderungsantrag.xlsm").Activate  
Dim var1 As String
Dim var2 As String
    var1 = "000"  
    var2 = Range("G32").Value  
    NeuerOrdner = "C:\Users\xxx\xxx\xxx\Vorgaenge"  
    Set FSO = CreateObject("Scripting.FileSystemObject")  
    If Not FSO.Folderexists(NeuerOrdner) Then
        Set OrdnerPfadNeu = FSO.CreateFolder(NeuerOrdner)
    End If
    ThisWorkbook.SaveAs NeuerOrdner & "\" & var1 & var2 & ".xlsm"  
End Sub

Danke nochmal

Grüße

Amiga500

Hallo Amiga500

wenn du zwischen deiner Zeile 12 und 13 noch

Windows("Änderungsantrag.xlsm").Activate

einfügst, muss er wieder in der Änderungsantrag.xlsm stehen.

probier mal.

Viele Grüße

Tsuki

Index ist in Zeile 14 außerhalb des gültiges Bereichs sagt er mir beim Ausführen (Laufzeitfehler '9')

Private Sub button2_Click()
ActiveSheet.Unprotect
Dim var1 As String
Dim var2 As String
    var1 = "000"  
    var2 = Range("G32").Value  
    Range("H33").Value = var1 & var2 & ".xlsm"  
    NeuerOrdner = "C:\Users\luczakd\_Diverses\ss\Vorgaenge"  
    Set FSO = CreateObject("Scripting.FileSystemObject")  
    If Not FSO.Folderexists(NeuerOrdner) Then
        Set OrdnerPfadNeu = FSO.CreateFolder(NeuerOrdner)
    End If
    ThisWorkbook.SaveAs NeuerOrdner & "\" & var1 & var2 & ".xlsm"  
    Windows("Antrag.xlsm").Activate  
ActiveSheet.Protect
End Sub

Beim Debuggen meckert er mit der neuen Zeile: Windows("Antrag.xlsm").Activate
Hab das schon umbenannt, weil ich erst dachte das Umlaut (Ä) macht Probleme...

Index ist in Zeile 14 außerhalb des gültiges Bereichs sagt er mir beim Ausführen (Laufzeitfehler '9')

Logisch!
Weil, du speicherst unter... und damit ist deine Antrag.xlsm nicht mehr "da"
aber mit

ThisWorkbook.Close
Workbooks.Open Filename:="C:\Users\luczakd\_Diverses\ss\Antrag.xls"  

ab Zeile 15 und wenn du die jetzige Zeile 14 löscht wäre es dann ab Zeile14 müßte es ungetestet
funktionieren.

Gruss
Tsuki

Also er speichert richtig und schließt die Datei danach auch...
allerdings öffnet er den antrag nicht wieder neu...
die arbeitsmappe in excel bleibt dann leer nach klick des speicherbuttons...

Kann jetzt ja nur noch eine Kleinigkeit sein... ich sollte mir langsam wirklich ein vba buch zulegen ;)

Grüße

Amiga500

EDIT: hab mal die zeile für das schließen der aktiven tabelle rausgenommen...jetzt gehts
Danke Dir nochmal. Hast mir sehr geholfen

Falls es jemanden interessiert wie ich das Problem gelöst habe... hier nachfolgend der code

Private Sub button2_Click()
ActiveSheet.Unprotect
Dim var1 As String
Dim var2 As String
Dim x1 As Object
    var1 = "000"  
    var2 = Range("G32").Value  
    var3 = TextBox17
    Range("G33").Value = var1 & var2 & "_" & var3 & ".xlsm"  
    NeuerOrdner = "C:\Users\xxx\_Diverses\ss\Vorgaenge"  
    Set FSO = CreateObject("Scripting.FileSystemObject")  
    If Not FSO.Folderexists(NeuerOrdner) Then
        Set OrdnerPfadNeu = FSO.CreateFolder(NeuerOrdner)
    End If
    ThisWorkbook.Save
    ThisWorkbook.SaveAs NeuerOrdner & "\" & var1 & var2 & "_" & var3 & ".xlsm"  
    Workbooks.Open Filename:="C:\Users\xxx\_Diverses\ss\Änderungsantrag.xlsm"  
ActiveSheet.Protect
For Each x1 In Workbooks
  If x1.Name = var1 & var2 & "_" & var3 & ".xlsm" Then  
      Found = True
    End If
  Next x1
  If Found Then
    Workbooks(var1 & var2 & "_" & var3 & ".xlsm").Activate  
    ActiveWorkbook.Close SaveChanges:=False
  End If
End Sub

Hallo Amiga500

Danke Dir nochmal. Hast mir sehr geholfen

Gerne und keine Ursache!

Dir auch allerbesten Dank dafür, dass du zum Schluss das Ergebnis noch mal als ganzes preisgibst.
Oft sind Beiträge nur gelöst, aber ohne genaues Feedback, bzw. Lösung.

Viele Grüße

Tsuki

gelöst Frage Microsoft Microsoft Office

Heiß diskutiert