Vorletzte Listobject-Zeile vor Einfügen neuer Zeile ändern
03.02.2024 15:57:26
FranziskusV
Ich brauche mal wieder Hilfe.
Jetzt kommt der Kontext zu meinem Problem :
Über folgenden Code füge ich über eine Schaltfläche eine Blattzeile ein. Diese Blattzeile wird so eingefügt, dass damit auch automatisch eine Intelligente Tabelle (Listobject mit Name= "TbMonatlicherStand") an ihrem Ende erweitert wird.
Das klappt ganz gut. Denn damit bekomme ich eine automatische Erweiterung der Tabelle ohne dass dies zu einer Verschiebung zu den Zellbereichen rundherum führt.
Im Listobject werden in der neuen Zeile auch automatisch alle Formatierungen und bedingten Formatierungen der übernommen. Soweit alles gut.
Im Listobject wird in der letzten Spalte eine zeilenweise Validierung der Eingaben (in den Zeilen dieser Intelligenten Tabelle) gemacht. Dazu stellt der Benutzer den Wert der letzten Zelle in der Zeile auf "Ja" (über eine entsprechend begrenzte Auswahl). Diese Validierung löst über das Worksheet_Change Ereignis einen Code aus, der die gesamte Zeile in der Intelligenten Tabelle sperrt und auch in einer bestimmten Farbe hervorhebt. Alle Zellen (in der Arbeitsmappe) die (warum auch immer) nicht mehr für die Eingabe frei sind werden in eine bestimmte hellgrüne Farbe gesetzt. Dies geschieht überall im Tabellenblatt mittels der bedingten Formatierung, und an dieser Stelle über den VBA Code bei Valdierung der Zeile mit "Ja".
Hier der Teil des Codes im Worksheet_Change Ereignis, der die Anpassungen nach der Validierung macht.
Dim tbl As ListObject
For Each tbl In Me.ListObjects
If Target.Column = tbl.ListColumns.Count Then
Me.Unprotect ' Blattschutz aufheben
' Überprüfe, ob in der letzten Spalte "Ja" oder "Nein" steht
If UCase(Target.Value) = "JA" Then
Intersect(tbl.DataBodyRange, Target.EntireRow).Locked = True
Intersect(tbl.DataBodyRange, Target.EntireRow).Interior.Color = RGB(211, 236, 185)
ElseIf UCase(Target.Value) = "NEIN" Then
Intersect(tbl.DataBodyRange, Target.EntireRow).Locked = False
Intersect(tbl.DataBodyRange, Target.EntireRow).Interior.ColorIndex = xlNone ' Zurücksetzen der Hervorhebung
End If
Me.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True, AllowSorting:=True, AllowFiltering:=True
End If
Next tblZellen die noch frei sind für die Eingabe (haben eine bestimmte hellrote Farbe - in der ist auch die Bodyrange der Intelligenten Tabelle formatiert.- Im Laufe der Arbeit füllt der Benutzer also nach und nach alle Zellen die hellrot sind aus, bis keine mehr da sind. Allerdings gibt es in einem bestimmten Bereich die Möglichkeit durch das Einfügen von Zeilen die Intelligente Tabelle die in das Tabellenblatt integriert ist zu erweitern und so eine (oder mehrere) Eingabezeilen zu generieren. Das geschieht normalerweise monatlich, denn der Benutzer füllt über diese Arbeitsmappe eine Fortschrittbericht aus der monatlich aktualisiert werden muss. Der Benutzer füllt also Zeile für Zeile monatlich aus und dokumentiert auf diese Weise den Fortschritt. Die Ergebniszeile der Intelligenten Tabelle liefert hierbei eine Summierung gewisser Eingaben und damit einen aktuellen Fortschrittsbericht der an eine Art Gesamtübersicht weitergegeben wird und der sich auf diese Weise monatlich aktualisiert, wenn die jeweiligen Eingaben in der letzten Spalte der Intelligenten Tabelle validiert wurden. Ich hoffe das ist soweit verständlich.
Jetzt kommt mein eigentliches Problem :
Damit die Ergebniszeile der Intelligenten Tabelle stimmige Ergebnisse liefert, ist es wichtig dass alle Zeilen validiert sind (am Ende mit "Ja" was den VBA-Code über das Change Ereignis auslöst und die Zeile sperrt und in hellgrün einfärbt). Dieses Einfärben in hellgrün mittels Code ist aber mein Problem. Denn wenn ich jetzt die letzte Zeile in hellgrün habe, und eine neue unterhalb hinzufüge, dann wird die auch hellgrün und die Zellen sind ausserdem automatisch gesperrt. Denn die eingefügte Zeile wird so formatiert wie die darüberliegende (von der sie formatmässig und was die Formeln in der intelligenten Tabelle angeht ein Abklatsch ist). Aber hier ist seitens des Benutzers in die neu eingefügte Zeile noch keine Eingabe erfolgt und deshalb müssten diese Zellen hellrot und offen sein; damit der Benutzer die neue Zeile auch als solche erkennt und ausfüllen kann.
Was ich mir wünsche ist eine Anpassung des folgenden Codes um das Problem der gesperrten Zellen und falschen Farbe in der eingefügten Zeile zu umgehen.
Ich hatte mir als Lösung gedacht den Code der die Zeile einfügt anzupassen damit :
-VOR dem Einfügen einer neuen Blattzeile über VBA folgendes passieren.
In der Intelligenten Tabelle
-sollen die Zellen der letzten Zeile entsperrt werden.
-sollen die Hervorhebung der Zellen zurück gesetzt werden
Intersect(tbl.DataBodyRange, Target.EntireRow).Interior.ColorIndex = xlNone ' Zurücksetzen der Hervorhebung-Jetzt soll die Blattzeile eingefügt werden (siehe nachfolgenden Code)
-Dann soll NACH dem Einfügen der Blattzeile
In der Intelligenten Tabelle
-sollen die Zellen der vorletzten Zeile gesperrt entsperrt werden.
-sollen die Hervorhebung der Zellen wieder auf hellgrün gesetzt werden
Interior.Color = RGB(211, 236, 185) 'in der vorletzten Zeile diesmal Dadurch wird die neu eingefügte Blattzeile in der Intelligenten Tabelle aussehen wie eine "normale leere Zeile in hellrot und nicht gesperrt.
Soweit meine Idee. Aber ich bin selbst nicht in der Lage den folgenden Code entsprechend anzupassen.
Private Sub CommandButton3_Click()
'=> Monatlicher Stand der Ernte
'Fügt eine Blattzeile ein so dass die intelligente Tabelle 'Monatlicher Stand' um eine Zeile nach unten erweitert wird.
Dim ws As Worksheet
Dim meineTabelle As ListObject
Dim letzteZeile As Long
Dim blattZeilennummer As Long
' Me.Unprotect 'Blattschutz aufheben
Set ws = Me
Set meineTabelle = ws.ListObjects("TbMonatlicherStand") '!!! Namen der intelligenten Tabelle anpassen
' Ermittle die letzte Zeile in der Tabelle
letzteZeile = meineTabelle.ListRows.Count
' Überprüfe, ob die Tabelle Zeilen hat
If letzteZeile > 0 Then
' Ermittle die Blattzeilennummer der letzten Zeile
blattZeilennummer = meineTabelle.ListRows(letzteZeile).Range.row
' Springe eine Zeile tiefer und füge eine neue Zeile ein
ws.Rows(blattZeilennummer + 1).Insert Shift:=xlDown
' Jetzt kannst du mit der neu eingefügten Zeile arbeiten
MsgBox "Eine Zeile für eine weitere Übernahme wurde eingefügt"
Else
MsgBox "Die Tabelle hat keine Zeilen."
End If
' Me.Protect 'Blattschutz wieder setzen
End SubIch wûrde mich über Hilfe sehr freuen. Hoffentlich ist verständlich was ich bräuchte. Falls nicht könnte ich versuchen eine Musterdatei hochzuladen...das ist aber nicht so einfach.
LG,
FranziskusV