103540
103540
Mar 02, 2012
view16146
view13
0
Goto Top

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

GermansolvedQuestionMicrosoft OfficeMicrosoft
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
comment-contentCommentShareShare
Share on Facebook Share on Twitter Share on Reddit Share on Linkedin

Content-Key: 181332

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

Printed on: April 19, 2024 at 05:04 o'clock

13 Comments
Latest comment
Goto Top
Member: vossbaer
vossbaer Mar 02, 2012 at 09:16:06 (UTC)
Goto Top
Habe nur kurz draufgeschaut. Kann es sein das Du den öffnen Dialog ansprichst bevor Du den Namen ermittlst. Müsste das nicht hinterher geschehen?
Mitglied: 103540
103540 Mar 02, 2012 at 11:19:41 (UTC)
Goto Top
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
Member: TsukiSan
TsukiSan Mar 02, 2012 at 13:46:05 (UTC)
Goto Top
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) face-wink
NeuerOrdner = "Vorgaenge"  

Set FSO = CreateObject("Scripting.FileSystemObject")  

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

Gruss
Tsuki
Mitglied: 103540
103540 Mar 02, 2012 at 14:40:58 (UTC)
Goto Top
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
Member: TsukiSan
TsukiSan Mar 02, 2012 at 14:47:56 (UTC)
Goto Top
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
Member: TsukiSan
TsukiSan Mar 02, 2012 at 14:57:49 (UTC)
Goto Top
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
Mitglied: 103540
103540 Mar 05, 2012 at 07:40:18 (UTC)
Goto Top
Hallo TsukiSan,

ich hoffe du hattest ein schönes WE face-smile

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 face-smile


Grüße

Amiga500
Member: TsukiSan
TsukiSan Mar 05, 2012 at 08:40:21 (UTC)
Goto Top
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
Mitglied: 103540
103540 Mar 05, 2012 at 09:11:22 (UTC)
Goto Top
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...
Member: TsukiSan
TsukiSan Mar 05, 2012 at 12:19:23 (UTC)
Goto Top
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
Mitglied: 103540
103540 Mar 05, 2012 at 12:47:59 (UTC)
Goto Top
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 face-smile
Mitglied: 103540
103540 Mar 05, 2012 at 13:40:05 (UTC)
Goto Top
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
Member: TsukiSan
TsukiSan Mar 06, 2012 at 01:53:58 (UTC)
Goto Top
Hallo Amiga500

Danke Dir nochmal. Hast mir sehr geholfen face-smile
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
GermansolvedQuestionMicrosoft OfficeMicrosoft
Hotly discussed
AlexWishaHow to set up and configure a Linux GRE tunnelAlexWisha - 3 CommentsjstrickerWIREGUARD VPN ON UDM PRO BEHIND FRITZBOX - HANDSHAKE DID NOT COMPLETEjstricker - 2 CommentsDaniEnd of Support dates for Office 2016, 2019 Apps und Productivity ServersDani - 1 Comment