MS Excel

Zdravím vás všechny, měl bych dotaz.
Když mám v A1, B1 a C1 hodnotu (0-255), mohu pomocí VBA dostat barvu v D1?
Příklad: V A1 bude 0, B1 = 0 a C1 = 0, obarví se mi D1 černou barvou.
Lze to a jak, prosím?
Děkuji moc, B

Zaslat odpověď >

Lugr(16.1.2023 9:52)#054227

Private Sub Worksheet_Change(ByVal Target As Range)

Dim KeyCells As Range
Set KeyCells = Range("A1:C1")

If Not Application.Intersect(KeyCells, Range(Target.Address)) Is Nothing Then

If Range("A1").Value > "" And Range("A1").Value = 0 And Range("B1").Value > "" And Range("B1").Value = 0 And Range("C1").Value > "" And Range("C1").Value = 0 Then
Range("D1").Interior.Color = vbRed
Else
Range("D1").Interior.Pattern = xlNone
End If

End If

End Subcitovat

r13(16.1.2023 12:13)#054233

Spúšťače a kontroly si zvoľ podľa potreby.
Podstata je tu:

Range("D1").Interior.Color = RGB(Range("A1"), Range("B1"), Range("C1"))citovat

r13(16.1.2023 12:36)#054235

Napr s využitím časti Lugrovho kódu by to bolo takto:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim KeyCells As Range
Set KeyCells = Range("A1:C1")
If Not Application.Intersect(KeyCells, Range(Target.Address)) Is Nothing Then
If Range("A1").Value >= 0 And Range("A1").Value <= 255 And Range("B1").Value >= 0 And Range("B1").Value <= 255 And Range("C1").Value >= 0 And Range("C1").Value <= 255 Then
Range("D1").Interior.Color = RGB(Range("A1"), Range("B1"), Range("C1"))
Else: Range("D1").Interior.Pattern = none
End If
End If
End Subcitovat

elninoslov(16.1.2023 12:49)#054236

Je možnosť použiť a featurku EVALUATE a funkciu volanú z bunky. Má to jednu výhodu, že Vám dovolí 1x Undo.
Function RGBCOLOR(RNG As Range, R As Range, G As Range, B As Range) As Variant
Application.Volatile
Evaluate "RGBEVAL(""" & RNG.Address(1, 1, 1, 1) & """," & rgb(R.Value, G.Value, B.Value) & ")"
End Function
Sub RGBEVAL(RNG As String, colRGB As Double)
Range(RNG).Interior.Color = colRGB
End Sub

Příloha: zip