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

Mein Fehler. xlsM ist ja extra für Makros erfunden worden da mit es sich vom gewöhnlichen xlsX (für XLM vermutlich) abgrenzt. Schöne neue Welt. Mit reicht halt O2k…

Eric March

Answer 2

Hallo,
so bin jetzt hier im Urlaub mal kurz online! Also ich habe es genau so unter office 2010 laufen lassen und macht
eigentlich gar nichts! Aber näheres kann ich erst wieder Montag testen!

Danke schon mal!

Gruß tobi

Answer 3

Hallo Eric,

war eine Wocheim Urlaub! Also mein office frisst das nicht, wenn ich ich xlsx eingebe hat er Probleme und schreibt Fehler!
Ändere ich es in xls läuft es.
Du schreibst bei Dir klappt es! Rainer schreibt das geht nicht, bin jetzt ein wenig irritiert!


Gruß Tobias

Answer 4

Hallo,

habe es jetzt so gemacht mit Hilfe! Klappt auch mot der Endung xlsx!

Private grundpfad As String, derivat As String
Public speichern_aktiv As Boolean

Sub SpeichernUnter()

grundpfad = "\\.........\Beanstandungsverfolgungsblatt\BVBsG1\"
derivat = "G1"

Dim kurzbez As String
Dim erfassungsdatum As String
Dim ersteller As String
Dim nummer As String

kurzbez = Range("D4")
erfassungsdatum = Range("S4")
ersteller = Range("A6")
nummer = Range("W4")

If kurzbez = "" Or erfassungsdatum = "" Or ersteller = "" Then
MsgBox "Bitte die gelb markierten Pflichtfelder ausfüllen", vbOKOnly, "Pflichtfelder"
'Range("d4, s4, a6").Activate
Exit Sub
End If

Dim akt_pfad As String
Dim pfad As String
Dim jahr As String
Dim dateiname As String
Dim blattnummer As String
Dim ist_neu As Boolean

'akt_pfad = ActiveWorkbook.Path
jahr = Format(Now, "yyyy\\")
pfad = grundpfad & jahr

If nummer = "" Then
blattnummer = erstelle_blattnummer(pfad)
Range("W4").Value = blattnummer
ist_neu = True
ActiveSheet.DrawingObjects("Button 21").Delete
ActiveSheet.Range("y13").Comment.Delete
Else
blattnummer = nummer
ist_neu = False
End If

dateiname = pfad & blattnummer & ".xlsx"

' MsgBox dateiname
' Exit Sub

speichern_aktiv = True

Application.DisplayAlerts = False
ActiveWorkbook.SaveAs dateiname, xlWorkbookDefault
Application.DisplayAlerts = True

If ist_neu Then
erstelle_verknuepfung blattnummer, dateiname, jahr
End If

MsgBox "Blatt wurde gespeichert", vbOKOnly, "gespeichert"

speichern_aktiv = False

End Sub

Function ist_blatt_frei(blatt As String)

Dim filesys, ordner, files, file

Set filesys = CreateObject("Scripting.FileSystemObject")

If filesys.FileExists(blatt) Then
ist_blatt_frei = False
Exit Function
End If

ist_blatt_frei = True
End Function

Function erstelle_blattnummer(pfad)

Dim temp_nummer As String, jahr As String
Dim counter As Integer

counter = 0
jahr = Format(Now, "yyyy")

Do
counter = counter + 1
temp_nummer = derivat & "_L" & jahr & "_" & Format(counter, "000")
Loop While Not ist_blatt_frei(pfad & temp_nummer & ".xlsx")

erstelle_blattnummer = temp_nummer

End Function

Sub erstelle_verknuepfung(blattnummer As String, dateiname As String, jahr As String)

Dim uebersicht As Workbook
Dim uebersicht_blatt As Worksheet
Dim uebersicht_dateiname As String, zellenname As String, pfad As String
Dim verknuepfung_basis As String
Dim counter As Integer

uebersicht_dateiname = grundpfad & "ÜbersichtBvb" & derivat & ".xlsx"

Set uebersicht = Workbooks.Open(uebersicht_dateiname, 3)
Set uebersicht_blatt = uebersicht.Worksheets(1)

counter = 2

With uebersicht_blatt

Do
counter = counter + 1
zellenname = Format(counter, "A0")
Debug.Print zellenname
Loop While .Range(zellenname) <> ""

verknuepfung_basis = "='" & grundpfad & jahr & "[" & blattnummer & ".xlsx]" & derivat & "Bvb1'!"

.Range(zellenname).Value = verknuepfung_basis & "W4"
.Hyperlinks.Add .Range(zellenname), dateiname, ScreenTip:=blattnummer

zellenname = Format(counter, "B0")
.Range(zellenname) = verknuepfung_basis & "D4"

zellenname = Format(counter, "\C0")
.Range(zellenname) = verknuepfung_basis & "S4"

zellenname = Format(counter, "\D0")
.Range(zellenname) = verknuepfung_basis & "E8"

End With

uebersicht.Save
uebersicht.Close

End Sub

Gruß
Tobias