Ve spolupráci se SEDUO jsem vytvořil několik videokurzů:
Potřebujete-li využitím VBA v Excel pracovat s barvou, někdy se hodí vědět číslo barvy, někdy Hex kód, případně složky RGB. V tomto článku se dozvíte jak z barvy (například pozadí zjistit požadované hodnoty).
V tomto článku se dozvíte, jak barvy zjistit a zapsat do buňky. Příklady budou ve dvou provedeních, pokud potřebuji pro konkrétní buňku, nebo pro oblast buněk. Pro přehlednost je článek rozdělen na kapitoly:
Nejjednodušší zobrazit (případně zapsat do buňky) číslo barvy.
Zvolíme aktivní buňku, do které zapíšeme číslo barvy:
barva = ActiveCell.Interior.Color
' MsgBox (Barva)
ActiveCell.Value = barva
Potřebujeme-li pracovat s oblasti, do které zapíšeme čísla barev pozadí buněk.
Dim Cell As Range
Dim barva As Long
For Each Cell In Selection
barva = ActiveCell.Interior.Color
Cell.Value = barva
Next Cell
Pro zobrazení v RGB rozdělíme na jednotlivé složky, víme-li že R - rudá je 0 - 255, G - zelená je 0 - 255 a B - modrá je také 0 - 255 a ono číslo z předchozí kapitoly je číslo rudé složky, krát číslo zelené složky a krát číslo modré složky:
Dim barva As Long
Dim CisloR As Integer
Dim CisloG As Integer
Dim CisloB As Integer
barva = ActiveCell.Interior.Color
' MsgBox (Barva)
CisloR = barva And 255
CisloG = barva \ 256 And 255
CisloB = barva \ 65536 And 255
ActiveCell.Value = "R: " & CisloR & " ,G: " & CisloG & " ,B: " & CisloB
Potřebujeme-li zapsat RGB hodnoty do oblasti:
Dim Cell As Range
Dim barva As Long
Dim CisloR As Integer
Dim CisloG As Integer
Dim CisloB As Integer
For Each Cell In Selection
barva = ActiveCell.Interior.Color
CisloR = barva And 255
CisloG = (barva) \ 256 And 255
CisloB = (barva) \ 65536 And 255
Cell.Value = "R: " & CisloR & " ,G: " & CisloG & " ,B: " & CisloB
Next Cell
V další ukázce se podíváme na HEX hodnotu, neboli převod hodnot ve formátu RGB do HEX (šestnáctkové podoby), jen je potřeba si uvědomit, pokud bude výsledek převodu 0 tak potřebujeme mít ve výsledku dvě nuly (obdobně pro 3 hodnotu 03, atd.).
Využijeme opět hodnotu z pozadí a číslo z daných barev RGB převedeme do HEX formátu:
barva = ActiveCell.Interior.Color
'
CisloR = VBA.Right$("00" & VBA.Hex(barva And 255), 2)
CisloG = VBA.Right$("00" & VBA.Hex(barva \ 256 And 255), 2)
CisloB = VBA.Right$("00" & VBA.Hex(barva \ 65536 And 255), 2)
ActiveCell.Value = "#" & CisloR & CisloG & CisloB
Budemeli potřebovat zapsat hodnoty HEX do oblasti:
Dim Cell As Range
Dim barva As Long
Dim CisloR As String
Dim CisloG As String
Dim CisloB As String
For Each Cell In Selection
barva = ActiveCell.Interior.Color
'
CisloR = VBA.Right$("00" & VBA.Hex(barva And 255), 2)
CisloG = VBA.Right$("00" & VBA.Hex(barva \ 256 And 255), 2)
CisloB = VBA.Right$("00" & VBA.Hex(barva \ 65536 And 255), 2)
Cell.Value = "#" & CisloR & CisloG & CisloB
Next Cell
Jak RGB zjisti z HEX, aneb převod Hex na číslo (FF v hex je 255 v desítkové soustavě):
hexColor = ActiveCell.Value
hexColor = Replace(hexColor, "#", "")
' MsgBox hexColor
GetBFromHex = Val("&H" & Mid(hexColor, 5, 2))
GetGFromHex = Val("&H" & Mid(hexColor, 3, 2))
GetRFromHex = Val("&H" & Mid(hexColor, 1, 2))
MsgBox ("R:" & GetRFromHex & " G:" & GetGFromHex & " B:" & GetBFromHex)
Jednotlivé čísla barev RGB převedu na Hex (0 je v hexa 0, 255 je v hexa FF).
Ruda = Cells(64, 3).Value
Zelena = Cells(65, 3).Value
Modra = Cells(66, 3).Value
GetHexFromRGB = "#" & Right$("00" & Hex(Ruda), 2) & _
Right$("00" & Hex(Zelena), 2) & Right$("00" & Hex(Modra), 2)
MsgBox (GetHexFromRGB)
Jen musím číslo rozdělit, když vím že číslo barty je: R + G *256 + B * 256 * 256
barva = ActiveCell.Value
' MsgBox (Barva)
CisloR = barva And 255
CisloG = barva \ 256 And 255
CisloB = barva \ 65536 And 255
MsgBox ("R: " & CisloR & " ,G: " & CisloG & " ,B: " & CisloB)
Číslo přečtu z buňky, přípandě mohu vylepčit a číslo zjistit z barvy textu, pozadí:
barva = ActiveCell.Value
' MsgBox (Barva)
CisloR = barva And 255
CisloG = barva \ 256 And 255
CisloB = barva \ 65536 And 255
GetHexFromNumber = "#" & Right$("00" & Hex(CisloR ), 2) & _
Right$("00" & Hex(CisloG ), 2) & Right$("00" & Hex(CisloB), 2)
MsgBox (GetHexFromNumber)
Převedu HEX na číslo a pak jen hodnoty pronásobím.
hexColor = ActiveCell.Value
hexColor = Replace(hexColor, "#", "")
' MsgBox hexColor
GetRFromHex = Val("&H" & Mid(hexColor, 1, 2))
GetGFromHex = Val("&H" & Mid(hexColor, 3, 2))
GetBFromHex = Val("&H" & Mid(hexColor, 5, 2))
Cislo = GetRFromHex + (GetGFromHex *256) + (GetBFromHex *256*256)
MsgBOx (Cislo)
Jednoduchý případ, kdy z RGB potřebuji čílo, stačí jen pronásobit ;)
Ruda = Cells(127, 3).Value
Zelena = Cells(128, 3).Value
Modra = Cells(129, 3).Value
Cislo = Ruda + (Zelena *256) + (Modra *256*256)
MsgBOx (Cislo)
Soubor ke stažení zdarma je v přípravě. Podpořit zveřejnění můžete podporou na Patreon.
Narazili jste na nějaké problémy, máte tip, můžete se zmínit v komentářích.
Článek byl aktualizován: 27.01.2021 09:18
Ušetřil vám tento web čas, peníze? Pomohl vyřešit problém? Jste ochotni poskytnout symbolickou odměnu na další rozvoj? Vybrte si formu odměny, která vám vyhovuje.
Microsoft Office (Word, Excel, Google tabulky, PowerPoint) se věnuji od roku 2000 (od 2004 na této doméně) - V roce 2017 jsem od Microsoft získal prestižní ocenění MVP (zatím jsem jediný z ČR v kategorií Excel). Své vědomosti a zkušenosti dávám k dispozici i on-line ve videích pro SEDUO. Ve firmách školím a konzultuji, učím na MUNI. Tento web již tvořím přes 15 let. Zdarma je zde přes 1.000 návodu, tipů a triků, včetně přes 250 různých šablon, sešitů.
Můžete být prvními co zanechají smysluplný komentář.
Pomohl Vám návod? Sdílejte na Facebooku, G+ |
||
LinkedIn... |
Stránky o MS Office (Excel) produktu společnosti Microsoft. Neslouží jako technická podpora.
| Email na autora: pavel.lasak@gmail.com | Copyright © : Pavel Lasák 2004 - 2024 |