Highlight code +

Voorbeeld2

Plaats onderstaande code onder de programmacode van een tabblad in Excel en pas de aangegeven waarden aan.

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

'==========================================================

'Waardes in het geheugen aanmaken
Dim Begin As String
Dim Einde As String
Dim EersteKolom As String
Dim EersteRij As String
Dim LaatsteKolom As String
Dim LaatsteRij As String
Dim KleurMarkering As String
Dim KleurRandTabel As String
Dim KleurMarkeringRechts As String

'==========================================================

'VUL HIERONDER HET BEREIK VAN DE MARKERING IN

'Startwaarde waarin de macro werkt
Begin = "B2"

'Eindwaarde waarin de macro werkt
Einde = "Y31"

'==========================================================

'VUL HIERONDER DE KLEUR IN

'Kleur van de rand van de tabel ( 47 = paars)
KleurRandTabel = 47

'Kleur markering (37 = lichtblauw)
KleurMarkering = 37

'Kleur markering rechts van actieve cell (36 = lichtgeel)
KleurMarkeringRechts = 36

'==========================================================

'MODULAIRE CODE - ALLEEN HET CIJFER OP HET EINDE VAN DE REGEL AANPASSEN INDIEN NODIG

'Rij kleuren vanaf kolom x, waarde wordt uit Begin gehaald
'Het cijfer op het einde van de regel is het aantal letters dat je bij "Begin" hebt ingevuld
EersteKolom = Left(Begin, 1)

'Rij kleuren vanaf kolom x, waarde wordt uit Begin gehaald
'Het cijfer op het einde van de regel is het aantal letters dat je bij "Einde" hebt ingevuld
LaatsteKolom = Left(Einde, 1)

'Kolom kleuren vanaf rij x, waarde wordt uit Begin gehaald
'Het cijfer op het einde van de regel is het aantal cijfers dat je bij "Begin" hebt ingevuld
EersteRij = Right(Begin, 1)

'Rij kleuren vanaf kolom x, waarde wordt uit Begin gehaald.
'Het cijfer op het einde van de regel is het aantal cijfers dat je bij "Einde" hebt ingevuld
LaatsteRij = Right(Einde, 2)

'==========================================================

'Kijken of de actieve selectie binnen het bereik valt
If Intersect(ActiveCell, Range(Begin, Einde)) Is Nothing Then

Else

'Achtergrond legen/kleuren. Wit = 2, leeg = 0
Range(Range(Begin).Offset(1, 1), Einde).Interior.ColorIndex = 0

'Markering toepassen (modulair)
Range(Cells(EersteRij, EersteKolom), Cells(EersteRij, LaatsteKolom)).Interior.ColorIndex = KleurRandTabel
Range(Cells(EersteRij, EersteKolom), Cells(LaatsteRij, EersteKolom)).Interior.ColorIndex = KleurRandTabel
Range(ActiveCell, Cells(ActiveCell.Row, LaatsteKolom)).Interior.ColorIndex = KleurMarkeringRechts
Range(ActiveCell, Cells(ActiveCell.Row, EersteKolom)).Interior.ColorIndex = KleurMarkering
Range(ActiveCell, Cells(EersteRij, ActiveCell.Column)).Interior.ColorIndex = KleurMarkering

End If

End Sub