[
attachment=22278]
Moin alle miteinander
Wenn ich Euch jetzt mein Problem Erkläre werdet ihr Sicher Sagen das ist ja nicht so schwer.
Für mich schon.
Ich habe ja auch von einem User aktive Hilfe bekommen in Form eines Buches,
fand ich richtig Top!!!!
Aber ich komme manchmal nicht so voran wie ich es gerne möchte.
Nun gut, wie fange ich an?
Ich möchte mit Vba ein Formular Speichern unter einem Pfad und der Dateiname wird aus einer Celle (bzw. 2 Cellen ) erstellt.
Nach dem Speichern soll das Formular mit der nächsten Blattnummer wieder sichtbar sein um es erneut Auszufüllen ,und da komme ich nicht weiter
Das ist meine Sub bisher
'Sub FormularLeeren()
ActiveWorkbook.SaveAs "e:\" & Range("AD1").Value & Range("AF1").Value & ".xlsm" _
, FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
Workbooks.Open Filename:="e:\Master.xlsm"
Workbooks("Master.xlsm").Activate
Workbooks(1).Close
'End Sub
Beispiel lade Euch hoch .
Soweit so gut, wie oder mit welcher Methode kann ich erreichen das
Beispiel "Master.xlsm" die Startdatei ist, in die ich Daten eintrage .
Diese wird unter "Blatt1.xlsm" gespeichert und geschlossen.
Danach öffnet sich die ‘‘Master.xlsm“ mit "Blatt2" usw.(AD1 ist Blatt AF1 die Nr.)
Habt ihr eine Idee oder einen Lösungsvorschlag.
Ich wäre euch sehr Dankbar.
Viele Grüße aus dem Lauenburg Ronny
Hallo
warum viele "krumme Wege" gehen, wenn man bequem gerade auslaufen kann?? Der untere Code erstellt eine neue Datei als xlsx und ohne Button!!
Die neue Datei bleibt geöffnet damit man das Blatt direkt bearbeiten kann. Ob man das Original schliesst musst du entscheiden. Im Augenblick Ja.
mfg Gast 123
Code:
Sub FormularLeeren()
Dim Datei As String, Nummer As Long
With ThisWorkbook.Worksheets("BETONPRÜFUNG leer")
On Error GoTo Fehler
'Nummer erst beim Erstellen erhöhen!!
Nummer = .Range("AF2").Value + 1
If Nummer = Empty Then MsgBox "Keine Nummer vorhanden": Exit Sub
Datei = "E:\" & .Range("AD1") & Nummer & ".xlsx"
'dieses Blatt kopieren und umbenennen (Button löschen!!)
Worksheets("BETONPRÜFUNG leer").Copy
ActiveWorkbook.Sheets(1).Shapes(1).Delete
ActiveWorkbook.Sheets(1).Range("AF1") = Nummer
ActiveWorkbook.Sheets(1).Range("AF2") = Nummer - 1
ActiveWorkbook.Sheets(1).Name = "BETONPRÜFUNG"
'unter neuem Datei Namen speichern und Offen lassen!!
ActiveWorkbook.SaveAs Datei, FileFormat:=xlNormal, CreateBackup:=False
'jezt letzte Nummer notieren, ThlsDatei schliessen
.Range("AF2").Value = Nummer
ThisWorkbook.Save
ThisWorkbook.Close
End With
Exit Sub
Fehler: MsgBox "Unerwarteter Fehler aufgetreten"
End Sub
Hallo Ronny,
falls du folgenden Ansatz suchst, kopiere diesen Code in "DieseArbeitsmappe":
Code:
Option Explicit
Private Sub Workbook_Open()
strDateipfad = "e:\"
strDateiname = Range("AD1")
iLfdNr = 0
strDatei = strDateipfad & strDateiname & iLfdNr & ".xlsx"
Do
strDatei = strDateipfad & strDateiname & iLfdNr & ".xlsx"
If Len(Dir(strDatei)) = 0 Then Exit Do
iLfdNr = iLfdNr + 1
Loop
Range("AF1") = iLfdNr
End Sub
und folgenden Code in dein bisheriges Modul (Modul1):
Code:
Option Explicit
Public strDateipfad As String
Public strDateiname As String
Public strDatei As String
Public iLfdNr As Integer
Sub FormularLeeren()
iLfdNr = Range("AF1")
strDatei = strDateipfad & strDateiname & iLfdNr & ".xlsx"
If Len(Dir(strDatei)) > 0 Then
MsgBox strDatei & " existiert bereits!"
Exit Sub
End If
Application.DisplayAlerts = False
ActiveSheet.Copy
ActiveWorkbook.SaveAs strDatei
ActiveWorkbook.Close
MsgBox strDatei & " gespeichert."
Range("AF1") = Range("AF1") + 1
Application.DisplayAlerts = True
End Sub
Viel Erfolg.
Moin Lucky Joe
Ich danke dir erst mal und werde deine Vorschläge gleich mal testen
Erst mal vielen Dank und ein schönen Sonntag wünsche ich dir noch.
Grüße aus Lauenburg Ronny
Hallo Gast
Hm keine Ahnung warum ich immer um die ecke denken muß war schon immer so,aber danke für deinen Lösungsvorschlag werde ihn gleich mal testen.
Schönen Sonntag noch Ronny
[quote='LuckyJoe' pid='149213' dateline='1549188091']
Hallo Ronny,
falls du folgenden Ansatz suchst, kopiere diesen Code in "DieseArbeitsmappe":
Code:
Option Explicit
Private Sub Workbook_Open()
strDateipfad = "e:\"
strDateiname = Range("AD1")
iLfdNr = 0
strDatei = strDateipfad & strDateiname & iLfdNr & ".xlsx"
Do
strDatei = strDateipfad & strDateiname & iLfdNr & ".xlsx"
If Len(Dir(strDatei)) = 0 Then Exit Do
iLfdNr = iLfdNr + 1
Loop
Range("AF1") = iLfdNr
End Sub
und folgenden Code in dein bisheriges Modul (Modul1):
Code:
Option Explicit
Public strDateipfad As String
Public strDateiname As String
Public strDatei As String
Public iLfdNr As Integer
Sub FormularLeeren()
iLfdNr = Range("AF1")
strDatei = strDateipfad & strDateiname & iLfdNr & ".xlsx"
If Len(Dir(strDatei)) > 0 Then
MsgBox strDatei & " existiert bereits!"
Exit Sub
End If
Application.DisplayAlerts = False
ActiveSheet.Copy
ActiveWorkbook.SaveAs strDatei
ActiveWorkbook.Close
MsgBox strDatei & " gespeichert."
Range("AF1") = Range("AF1") + 1
Application.DisplayAlerts = True
End Sub
Viel Erfolg.
So mein Bester erst mal vielen Dank für deine Hilfe.
Ich habe erst nicht verstanden warum ich einen zweiten Code brauche,jetzt weis ich warum und bin wieder etwas schlauer.
Ich hab noch ein paar Sachen hinzugefügt, war ja jetzt einfach, und jetzt funktioniert es auch so wie ich es vor hatte.
Nochmal Danke für deine Hilfe.
Ich wünsche Dir eine schöne Woche.
LG aus Lauenburg Ronny
... schön, dass ich helfen konnte.