VBA-Befehle

Hallo,
ich bin Neuling mit VBA und benötige euer Schwarmwissen. Ich möchte die angehängte Datei wie folgt mittels VBA erweitern:
1. Teilnehmer können sich nur dann in die Tabelle eintragen, wenn ein Termin mit angegebener Teilnehmerzahl hinterlegt ist. Ohne Uhrzeit und Teilnehmerzahl soll keine Eintragung möglich sein.
2. Wenn ein Teilnehmer aus der Liste entfernt wird, soll dieses mittels Kommentar (mit Name des gelöschtem, Datum, Uhrzeit und Name der Person die gelöscht hat) angezeigt werden (zu mindestens als Roll-over Kommentar).
3. Wenn eine Anzahl von 10 Teilnehmern erlaubt ist, sollen die restlichen Spalten (11-14) schwarz gefärbt werden (Weiß nicht genau ob es auch mittels bedingter Formatierung geht).
4. Kann man für 12 Tabellenblätter (12 Monate) eine Makro für den automatischen Blattschutz für alle Blätter gleichzeitig einrichten ?
Ich hoffe es ist nicht zu kompliziert und es kann der ein oder andere behilflich sein.
Testdatei: https://www.herber.de/bbs/user/157445.xlsm

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

AW: VBA-Befehle

24.01.2023 14:47:01

Thomas

AW: VBA-Befehle

24.01.2023 14:53:01

GerdL

AW: VBA-Befehle

24.01.2023 15:30:12

Daniel

Private Sub Worksheet_Change(ByVal Target As Range) Dim C As Range If Not Intersect(Range("C3:R22"), Target) Is Nothing Then For Each C In Intersect(Range("C3:R22"), Target) If IsEmpty(Cells(C.Row, 2)) Or IsEmpty(Cells(C.Row, 3)) Or IsEmpty(Cells(C.Row, 4)) Then If Not IsEmpty(C) Then Application.EnableEvents = False C.Application.Undo Application.EnableEvents = True End If End If Next End If End Sub

Hi
1 + 2 mit diesem Code:
Zellbereich muss ggf angepasst werden, kann aber auch größer sein als notwendig
arrAlt muss in Zelle A1 beginnen, ansonsten passen Zeile und Spalte nicht ohne weitere Umrechnung

Option Explicit
Dim arrAlt
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
arrAlt = Range("A1:R22").Value
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Zelle As Range
Dim txt As String
If Not Intersect(Target, Range("C3:R22")) Is Nothing Then
    For Each Zelle In Intersect(Target, Range("C3:R22"))
        If Zelle.Value = "" And arrAlt(Zelle.Row, Zelle.Column) > "" Then
            On Error Resume Next
            txt = Zelle.Comment.Text
            If Err > 0 Then
                Zelle.AddComment
                Zelle.Comment.Text Text:="Gelöschte TN"
            End If
            On Error GoTo 0
            txt = txt & vbLf & "- " & arrAlt(Zelle.Row, Zelle.Column) & " gelöscht am: " & Date & " " & Time & " durch: " & Application.UserName
            Zelle.Comment.Text Text:=txt
        ElseIf Cells(Zelle.Row, 2) = "" Or Cells(Zelle.Row, 3) = "" Or Zelle.Column - 4 > Cells(Zelle.Row, 4) Then
            Application.EnableEvents = False
            Zelle.ClearContents
            Application.EnableEvents = True
        Else
        End If
    Next
End If
End Sub

3. das färben machst du über Bedingrte Fomratierung mit der Regel:

=SPALTE()>($D3+4)

4. du kannst ein Makro schreiben, musst dort aber jedes Blatt einzeln schüzten, bzw wenn es die Reihenfolge oder Benennung zulässt, mit einer Schleife arbeiten.
Gruß Daniel

Beliebteste Forumthreads (12 Monate)

3 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

3
Beiträge zum Forumthread

Beiträge zu diesem Forumthread