Wert/Text aus einer bestimmter Zelle in Ordner speichern!

Question

Hallo,

ich brauche mal Eure Hilfe.

... möchte mit Excel 2010 eine fortlaufende Datenbank (in Ordnern sollen einzelne Blätter mit Problemen zur Abarbeitung hinterlegt werden) erstellen.
Sie soll im Firmennetzwerk von unterschiedlichsten Stellen in der Firma gespeichert und geöffnet werden.

Dabei soll eine Vorlage geöffnet und ausgefüllt werden.
Eine Blattbezeichnung in der Vorlage in der Zelle W4 soll automatisch auch der Speichername sein.

Habe hier viel aus dem Netz probiert und bin leider nicht zum Ziel gekommen.


Desweiteren sollen diverse Zelleninhalte (aus 3 Zellen) in einer Übersicht (andere Excel Tabelle) nach dem Speichern automatisch eingefügt werden, wobei es immer in eine neue Zeile geschrieben werden soll, nicht überschreiben.

Ist das überhaupt machbar!?????

Answer 1

Hallo,

klappt super!
Wie lange bist Du schon im Geschäft das Du dir das hier mal soeben aus dem Ärmel schüttelst!

Also mit xlsx hat er Probleme, schreibt er immer falsche Endung und bricht ab beim speichern.

Jetzt werde ich mich mal an die 3 Gewerke machen geht ja schnell.

Gruß Tobias

Answer 2

Moin,

jetzt würde ich gerne die Pflichtfelder wieder mit einbinden! Habe es mit dem obrigen code probiert läuft aber nicht!

Sub SpeichernUnter()
Dim NeuerName As String
NeuerName = Range("W4")
If NeuerName = "" Then
MsgBox ("Kein gültiger Name vergeben, Abbruch")
Exit Sub
End If
ActiveWorkbook.SaveAs "Z:\_230_Beanst_Montagen_T5\2012\" & NeuerName & ".xls"
End Sub

Gruß Tobias

Answer 3

Zu lange im Geschäft, aber so was ist schon ohne Nachzudenken zu tippen.

Warum hast du diese Sub wenn du sie nicht aus dem Worksheet_BeforeClose aurfufen willst bzw. einfach dort mit einbindest?

Entweder effektiv so wie gehabt oben, mit W4 im Paket

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Dim Pflichtbereich As Range
Dim Anzahl As Integer
Set Pflichtbereich = Worksheets("T5Bvb1").Range("D4,R4,W4,D5")
Anzahl = Pflichtbereich.Cells.Count
If Application.WorksheetFunction.CountA(Pflichtbereich) <> Anzahl Then
MsgBox "Bitte füllen Sie zuerst alle Pflichtfelder aus!", vbOKOnly + vbInformation, _
" Die Datei wird NICHT gespeichert!"
Cancel = True
Else
ThisWorkbook.SaveCopyAs ("Z:\_Neumann\BVBsT5\2012\" & Range("W4") & ".xlsx")
ActiveWorkbook.Close (False)
Cancel = False
End If
End Sub

Oder W4 mit einzelner Meldung:

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Dim Pflichtbereich As Range
Dim Anzahl As Integer
Set Pflichtbereich = Worksheets("T5Bvb1").Range("D4,R4,D5")
Anzahl = Pflichtbereich.Cells.Count
If Application.WorksheetFunction.CountA(Pflichtbereich) <> Anzahl Then
MsgBox "Bitte füllen Sie zuerst alle Pflichtfelder aus!", vbOKOnly + vbInformation, _
"Die Datei wird NICHT gespeichert!"
Cancel = True
Else
If Range("W4") = "" Then
MsgBox ("Kein gültiger Speicher-Name vergeben, Abbruch")
Exit Sub
Else
ThisWorkbook.SaveCopyAs ("Z:\_Neumann\BVBsT5\2012\" & Range("W4") & ".xlsx")
ActiveWorkbook.Close (False)
Cancel = False
End If
End If
End Sub

Offen gesagt bin ich gegen den (offenbar irgendwo geerbten Test-Code für sie anderen (nunmehr) 3 Zellen allergisch; «Application.WorksheetFunction» sind Dinge die ich als altgedienter Programmierer nicht mag wenn ich es mit richtigem Code kann:

… REM aus der Hand getippt
Dim Anzahl As Integer
If Cells(4,4)="" Or Cells(4,20)="" Or Cells(5,4)="" Then
MsgBox "Bitte füllen Sie zuerst alle Pflichtfelder aus!", vbOKOnly + vbInformation, _
"Die Datei wird NICHT gespeichert!"
Cancel = True
…

Das halte ich für lesbarer da ich nicht überlegen muss was der Range soll und was da nun mit CountA (Anzahl2?!) wieder gemeint ist.

Eric March

Answer 4

Hallo,
da swerde ich jetzt nochmal angehen mit beforeclose!


Gibt es eine Möglichkeit die Laufwerkbezeichnung frei zu lassen?
Der Buchstabe ist überall auf den einzelnen Rechner im Netz anders, ätz.

Gruß Tobias

Answer 5

Hallo,

schreib mir es bitte so hin wie Du es machen würdest und dann werde ichn es damit auf mein bvb anpassen! Halte nichts davon wenn Du mir hilfst und ich es dann mit allen zusammegewürfeltren mache.

MFG
Tobias

Answer 6

Nichts leichter denn dies:

Debug.Print ActiveWorkbook.FullName, ActiveWorkbook.Path

Da müsste man sich nur mit Left(ActiveWorkbook.FullName, 1) bedienen. Oder …2 wenn man den: mitnehmen möchte. Oder noch mehr wenn man Pfandangaben braucht.

Eric March

Answer 7

Ei, blöd. Ich hatte die Frage eine Weile offen, dann kam was dazwischen. Damit ging deine Nachfrage verloren.

«Wie ich es machen würde» würde sich durchaus von dem unterscheiden wie du es machen möchtest.
Da es sinnlos ist immer riesige Codeblöcke zu zitieren muss ich den Ball an dich zurückspielen denjenigen den du hast nachträglich anzupassen.

ThisWorkbook.SaveCopyAs ("Z:\_Neumann\BVBsT5\2012\" & Range("W4") & ".xlsx")

(ggf. ohne das x hinter dem xls) könnte hierzu werden:

ThisWorkbook.SaveCopyAs (Left (ActiveWorkbook.Path, 1) & ":\_Neumann\BVBsT5\2012\" & Range("W4") & ".xlsx")

was allerdings die Macke hat (zumindest vermute ich das weil ich so nie arbeite), dass du den Laufwerksbuchstaben des Laufwerks bekommst auf dem die Muster-Mappe liegt. Ist der ein anderer als das Ziel geht das natürlich schief. (Ich habe standardisierte Ziele, da muss ich da nicht rumrätseln O:-) )

Eric March

Answer 8

Hallo,

Sub SpeichernUnter()
Dim NeuerName As String
NeuerName = Range("W4")
If NeuerName = "" Then
MsgBox ("Kein richtiger Name vergeben, bitte geben sie einen gültige BlattNr. ein")
Exit Sub
End If
ActiveWorkbook.SaveCopyAs (Left(ActiveWorkbook.Path, 1) & ":\_Neumann\BVBsG1\2012\" & Range("W4") & ".xlsx")
End Sub

läuft nicht.:-(

Gruß tobias

Answer 9

Wo läuft es nicht?
Ich habe das (mit XLS statt XSLX) eben probiert und es läuft wie es zu erwarten wäre.
Eric March

Answer 10

Hallo Tobias,

ich hatte es bereits geschrieben, aber Du reagierst nicht darauf.

*:xlsx geht bei Excel ab Version 2007 nicht, da die Mappe ein Makro enthält.

So eine Mappe kannst Du nur als

Excel-Arbeitsmappe mit Makros *.xlsm

oder als

Excel-Binärarbeitsmappe *.xlsb

speichern.

Gruß
Rainer