< návrat zpět
MS Excel
Téma: VBA barva ![rss](./plugins/templates/wall_2C/images/icons/rss.png)
Zaslal/a Baja 15.1.2023 19:21
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
Lugr(16.1.2023 9:52)#054227 ![Lugr](./pictures/avatars/5ea444280f10d.jpg)
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 ![avatar](./pictures/avatars/no-avatar.jpg)
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 ![avatar](./pictures/avatars/no-avatar.jpg)
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 ![elninoslov](./pictures/avatars/5a6387658a0f4.jpg)
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 Subcitovat
Baja(16.1.2023 20:08)#054242 ![avatar](./pictures/avatars/no-avatar.jpg)
Nějak mi to nefunguje :(
Něco dělám špatně. V D1 mi to ukazuje chybu #NÁZEV
citovat
Stalker(16.1.2023 21:37)#054244 ![Stalker](./pictures/avatars/5a84a0f55ed4d.jpg)
Povol makra!
Pravé tl. myši - > Vlastnosti- Zabezpečení -> odblokovat
Příloha:
54244_wall.png (23kB, staženo 31x)
![54244_wall.png](./pictures/thumb/787d578ecce7f73e424ed70651e6e870.png)
citovat
Baja(16.1.2023 21:40)#054245 ![avatar](./pictures/avatars/no-avatar.jpg)
Já jsem debil :) Děkuji moc! Moc
citovat