Ik dacht dat het niet zo van belang was, maar hier komt ie
Private Sub Worksheet_Change(ByVal Target As Range)
Dim nX As Long
Dim nY As Long
Dim lAangekruisd As Boolean
Dim nDatumKolom As Long
Dim nGebeurtenisKolom As Long
'In de agenda wordt aangegeven welke gebeurtenis wanneer plaatsvindt
'én voor welke klassen deze gebeurtenis bedoeld is
'áls er met b.v. een spatie wordt aangegeven dat het bedoeld is voor bv groep 8 (kolom M)
'dan verandert het prg die spatie in de aanduiding van de groep zoals die staat op regel 19 (kopregel)
nDatumKolom = 4 'aanpassen aan instellingen in lesplanning
nGebeurtenisKolom = 26
Application.ScreenUpdating = False
Application.EnableEvents = False
If Target.Row < 20 Then
'pas vanaf regel 20 vinden mutaties plaats
GoTo Einde
End If
If Target.Column > nDatumKolom + 1 And Target.Column <> nGebeurtenisKolom Then
'er is een mutatie in een kolom van de groepsaanduidingen
If Sheets("Agenda").Cells(Target.Row, Target.Column).Value <> "" Then
'er is iets aangegeven, dat omzetten in aanduiding en kleur van de corresponderende kolom op rij 19
Cells(19, Target.Column).Select
Selection.Copy
Cells(Target.Row, Target.Column).Select
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
Cells(Target.Row, Target.Column).Value = Cells(19, Target.Column).Value
Else
'kleur van D(datum)-kolom terugzetten omdat cel eerder een (nu verwijderde) waarde en dus afwijkende kleur kan hebben
With Sheets("Agenda").Cells(Target.Row, Target.Column)
.Interior.Color = Cells(Target.Row, nDatumKolom).Interior.Color
End With
End If
End If
If Sheets("Agenda").Cells(Target.Row, nDatumKolom).Value <> "" And Sheets("Agenda").Cells(Target.Row, nGebeurtenisKolom).Value <> "" Then
'er is een datum en gebeurtenis ingevuld
lAangekruisd = False
'controleren of tenminste één groep is geselecteerd
For nY = nDatumKolom + 2 To nGebeurtenisKolom - 1
If Sheets("Agenda").Cells(Target.Row, nY).Value <> "" Then
'er is iets aangekruisd
lAangekruisd = True
nY = nGebeurtenisKolom - 1
End If
Next
If lAangekruisd = False Then
MsgBox "Geen groep(en) aangegeven voor wie de gebeurtenis geldt.", vbCritical, "Directie Agenda De Startbaan houdt z'n hart vast"
Cells(Target.Row, nDatumKolom + 1).Select
GoTo Einde
End If
'sorteer de agenda op datum
Call hgSorteer
'zoek de eerste lege regel voor nieuwe invoer
For nX = ActiveCell.Row To 2500
If Cells(nX, nDatumKolom).Value = "" Then
Cells(nX, nDatumKolom).Select
GoTo Einde
End If
Next
End If
Einde:
Application.ScreenUpdating = True
Application.EnableEvents = True
End Sub
