Hallo Zusammen
Hier eine richtige Herkules-Aufgabe:
Ich habe diverse Subs erstellt, mit denen ich in einer Datei arbeite. Hier wird fortlaufend pro Woche (KW 17, KW 18, etc) ein neues Tabellenblatt eingefügt, aus der Vorwoche die Formeln geholt und dann Daten aus einem System eingelesen.
Ich habe soweit alles eingerichtet, dass das alles über einen CommandButton läuft. Er fürht mittels Call alle einzelnen Subs auf.
Jetzt habe ich aber gesehen, dass es ab der nächsten Woche bereits nicht mehr läuft und möchte alles automatisieren, schaffe es aber nicht.
Meine Fragen:
1. Wie kann ich es einrichten, dass der CommandButton funktioniert, wenn ich die neue «Tabelle1» zur aktuellen KW umbenenne?
2.Kann ich das Umbenennen vielleicht automatisieren (immer die Aktuelle KW als Namen)
Hier der CommandButton:
Private Sub CommandButton1_Click()
Call AlleSubs
End Sub
Und unten die restlichen Subs:
Sub NeueWoche() 'Hier bereits automatisieren, wie die Tabelle heisst(Aktuelle KW)?
Sheets.Add Before:=ActiveSheet
Sheets(1).Name = "Tabelle1"
End Sub
Sub WochenBeschreibung() 'Hier kann die Kopfzeile der Tabelle eingefügt werden, dass immer aus der selben Tabelle oder der, der aktuellen KW
Sheets(2).Select
Rows("2:3").Select
Selection.Copy
Sheets("Tabelle1").Select
Rows("2:3").Select
ActiveSheet.Paste
Application.CutCopyMode = False
End Sub
Sub AlteInhalteLöschen() 'Hier müssen die alten Eingabedaten der vorherigen Woche gelöscht werden. Da müsste man nur den Namen der Tabelle (Aktuelle KW) einfügen.
Sheets("Tabelle1").Select
Range("I3:R3").Select
Selection.ClearContents
End Sub
Sub TxtEinfuegen() 'Hier werden die neuen Daten aus einer .txt-Datei eingelesen. Sie sollten in die aktuelle KW eingefügt werden
Dim Arr
Dim Datei
Dim FSO
Dim L As Long
Dim Tmp As Variant
Dim vnt_Ausgabe As Variant
Dim I As Integer
Dim Str_String As String
Set FSO = CreateObject("Scripting.FilesystemObject")
Set Datei = FSO.OpentextFile(ThisWorkbook.Path & "\query_export_results.txt")
Str_String = Datei.readall
Datei.Close
Arr = Split(Str_String, vbCrLf)
ReDim vnt_Ausgabe(UBound(Arr), 1000)
For L = 0 To UBound(Arr)
Tmp = Split(Arr(L), ";")
For I = 0 To UBound(Tmp)
vnt_Ausgabe(L, I) = Tmp(I)
Next
Next
Sheets("Tabelle1").Range("I3").Resize(UBound(vnt_Ausgabe) + 1, UBound(vnt_Ausgabe, 2)) = vnt_Ausgabe
End Sub
Sub ZeileLoeschen() 'Hier muss die erste Zeile (in der Aktuellen KW-Tabelle) gelöscht werden, da darin noch Beschreibungen sind.
Rows("3:3").Select
Selection.Delete Shift:=xlUp
End Sub
Sub FormelEinfügen() 'Hier werden die Formeln aus einem Tabellenblatt eingefügt. Die "KW 17" kann so bleiben, da sich die Formel nicht verändert, müsste aber in der aktuellen KW eingefügt werden
Sheets("KW 17").Select
Range("A3:G3").Select
Selection.Copy
Sheets("Tabelle1").Select
Range("A3:G3").Select
ActiveSheet.Paste
Application.CutCopyMode = False
End Sub
Sub DatumAnpassen() 'Das ist nur ein Pop-Up, damit man ein Datum in der Formel anpasst
MsgBox "Bitte das Datum in der Formel anpassen!", vbOKOnly, "Datum anpassen"
End Sub
Sub NeuerButton() 'Hier soll ein neuer CommandButton in der aktuellen KW-Tabelle eingefügt werden, mit dem man den ganzen Ablauf für die nächste Woche aktivieren kann.
Set NewButton = Worksheets("Tabelle1").Buttons.Add(255, 1, 180, 20)
NewButton.Caption = "Berechnen"
NewButton.Font.Bold = True
NewButton.OnAction = "AlleSubs.AlleSubs"
End Sub
Sub AlleSubs() 'Hier sind alle Subs für in den CommandButton
Call NeueWoche
Call WochenBeschreibung
Call AlteInhalteLöschen
Call TxtEinfuegen
Call ZeileLoeschen
Call FormelEinfügen
Call NeuerButton
Call DatumAnpassen
End Sub
Ich bin mir bewusst das das kompiziert ist, jedenfalls für mich als Anfänger.
Vielen Dank und Grüsse
Michael |