Voorwaardelijke opmaak in VBA

[Dimy]

Beste Excel specialsten,
Een tijdje geleden werd een soortgelijke vraag ivm voorwaardelijke opmaak reeds gesteld en beantwoord op dit forum maar ik had ze graag nog een beetje uitgebreid gezien.
Hierbij gevoegd een VBA code bij wijze van voorbeeld.
Bij ingave van één van de getallen zal de cel opgevuld worden met een kleur.
Mijn vraag is of deze code ook uitgebreid kan worden zodat bvb 5 cellen rechts naast het ingevulde getal ook diezelfde opvulkleur krijgen. (...Of zelfs de ganse rij)

Private Sub Worksheet_Change(ByVal Target As Excel.Range)
With Target
Select Case .Value
Case "1": .Interior.ColorIndex = 1
Case "2": .Interior.ColorIndex = 3
Case "3": .Interior.ColorIndex = 4
Case "4": .Interior.ColorIndex = 5
Case "5": .Interior.ColorIndex = 6
Case "6": .Interior.ColorIndex = 7
Case "7": .Interior.ColorIndex = 8
Case "8": .Interior.ColorIndex = 9
Case "9": .Interior.ColorIndex = 10
Case "10": .Interior.ColorIndex = 12
Case "11": .Interior.ColorIndex = 2
Case "12": .Interior.ColorIndex = 11
Case "13": .Interior.ColorIndex = 13
Case "14": .Interior.ColorIndex = 14
Case "15": .Interior.ColorIndex = 15
Case "16": .Interior.ColorIndex = 16
Case "17": .Interior.ColorIndex = 17
Case "18": .Interior.ColorIndex = 18
Case "19": .Interior.ColorIndex = 19
Case "20": .Interior.ColorIndex = 20
Case "21": .Interior.ColorIndex = 21
Case "22": .Interior.ColorIndex = 22
Case "23": .Interior.ColorIndex = 23
Case "24": .Interior.ColorIndex = 24
Case "25": .Interior.ColorIndex = 25
Case "26": .Interior.ColorIndex = 26
Case "27": .Interior.ColorIndex = 27
Case "28": .Interior.ColorIndex = 28
Case "29": .Interior.ColorIndex = 29
Case "30": .Interior.ColorIndex = 30
Case "31": .Interior.ColorIndex = 31
Case "32": .Interior.ColorIndex = 32
Case "33": .Interior.ColorIndex = 33
Case "34": .Interior.ColorIndex = 34
Case "35": .Interior.ColorIndex = 35
Case "36": .Interior.ColorIndex = 36
Case "37": .Interior.ColorIndex = 37
Case "38": .Interior.ColorIndex = 38
Case "39": .Interior.ColorIndex = 39
Case "40": .Interior.ColorIndex = 40
Case "41": .Interior.ColorIndex = 41
Case "42": .Interior.ColorIndex = 42
Case "43": .Interior.ColorIndex = 43
Case "44": .Interior.ColorIndex = 44
Case "45": .Interior.ColorIndex = 45
Case "46": .Interior.ColorIndex = 46
Case "47": .Interior.ColorIndex = 47
Case "48": .Interior.ColorIndex = 48
Case "49": .Interior.ColorIndex = 49
Case "50": .Interior.ColorIndex = 50
Case "51": .Interior.ColorIndex = 51
Case "52": .Interior.ColorIndex = 52
Case Else: .Interior.ColorIndex = xlNone
End Select
End With
End Sub

Dank voor jullie bereidwilligheid.
Dimy

 

[Wigi]

Private Sub Worksheet_Change(ByVal Target As Excel.Range)
    With Target.Range("A1")
        If .Value > 0 And .Value <= 52 Then .EntireRow.Interior.ColorIndex = .Value Else .EntireRow.Interior.ColorIndex = 0
    End With
End Sub

Wigi

 

[Dimy]

Hey Wimmeke,
Ik dacht het al dat je verhuisd was
We kwamen elkaar voortdurend tegen op die andere forum , je weet wel.
Hartelijk dank voor je hulp maar eigenlijk wil ik toch nog iets anders:
In jou code wordt er enkel met "A1" rekening gehouden en met een getal.
In mijn voorbeeld gebruikte ik die nummers (0 > 52) om een idee te krijgen.
En ongeacht waar ik een nummer plaatste werd die cel ingekleurd.
In mijn code kan ik bvb color nr44 toewijzen aan een bepaald woord in die cel.
Voor "A1" is dat geen probleem.
Nu wil ik natuurlijk hetzelfde voor A2 : A100. Telkens in de kolom A een bepaald woord voorkomt moet die rij , of een deel ervan gekleurd worden in de opgegeven kleur.
Da's heel andere koek hé.
Aan jou code heb ik een kleine verandering aangebracht ivm de range waar de kleur moet toegepast worden.

Private Sub Worksheet_Change(ByVal Target As Range)
With Target.Range("A1")
If .Value > 0 And .Value <= 52 Then Range("A1:F1").Interior.ColorIndex = .Value Else .Interior.ColorIndex = 0
End With

End Sub

Hopelijk kan je mijn uitleg een beetje volgen.
Thanks
Dimy

 

[jpvs]

Bedoel je dit?

Private Sub Worksheet_Change(ByVal Target As Excel.Range)
    Set rngIsect = Intersect(Target, [a:a])
    If Not (rngIsect Is Nothing) Then
        Select Case Target.Value
        Case "1"
            With Range(Cells(Target.Row, 2), Cells(Target.Row, 8))
                .Interior.ColorIndex = 1
                .Font.Bold = False
                .Font.Italic = False
            End With
        Case "2"
            With Range(Cells(Target.Row, 2), Cells(Target.Row, 8))
                .Interior.ColorIndex = 2
                .Font.Bold = False
                .Font.Italic = True
            End With
        Case "3"
            With Range(Cells(Target.Row, 2), Cells(Target.Row, 8))
                .Interior.ColorIndex = 3
                .Font.Bold = False
                .Font.Italic = False
            End With
        Case "4"
            With Range(Cells(Target.Row, 2), Cells(Target.Row, 8))
                .Interior.ColorIndex = 4
                .Font.Bold = True
                .Font.Italic = False
            End With
        Case Else
            With Range(Cells(Target.Row, 2), Cells(Target.Row, 8))
                .Interior.ColorIndex = 0
                .Font.Bold = False
                .Font.Italic = False
            End With
        End Select
    End If
End Sub

Pierre

 

[Wigi]

Dimy

Wat Pierre hierboven voorstelt, is mooi maar waarschijnlijk niet wat gevraagd wordt. Dat weet ik nl. ook niet want dat is nogal onduidelijk.

Ik vermoed ook dat jij met de Range("A1") denkt dat het over cel A1 gaat. Dat is niet zo. Target.Range("A1") is de cel linksboven van Target. Dit voor het geval Target (wat een range is) meerdere cellen bevat.

Het begin van Pierre's code kan je gerust overnemen, maar de rest hangt af van wat jij wil doen. En dat is onduidelijk (voor mij ten minste).

Wigi

 

[Dimy]

Hey
Bedankt hoor, Pierre en Wigi
Dit is in grote lijnen wat ik zocht. Hiermee kan ik al aardig wat experimenteren.
Thanks!
Dimy

 

[jpvs]

Dimy,

Als de vraag is opgelost mag je de vraag rechtsonderaan op "Vraag is opgelost" zetten.

Pierre