Přeskočit navigaci | Přeskočit na novinky

Jste zde: Úvodní stránka » excel » vba-listy-bunky » barvy-HEX-RGB-cislo-Excel-VBA
Microsoft Excel logo

Barvy RGB, HEX číslo - Excel VBA

Videokurzy Excel

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).

Úvodem do barev číslo, RGB, HEX

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:

VBA Excel barvy -

Zjistit číslo barvy

Nejjednodušší zobrazit (případně zapsat do buňky) číslo barvy.

Zapiš číslo barvy do buňky

Zvolíme aktivní buňku, do které zapíšeme číslo barvy:

barva = ActiveCell.Interior.Color ' MsgBox (Barva) ActiveCell.Value = barva

Zapsáni čísel barvy do oblasti

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 VBA Excel barvy - číslo

Zjisti RGB čísla složek

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

RGB zapsat do oblasti

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 VBA Excel barvy - RGB hodnota

Zobrazit HEX kód barvy

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.).

Hex do jedné buňky

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

HEX čísla do oblasti

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 VBA Excel barvy - HEX kód

RGB z HEX

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)

HEX z RGB

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)

RGB z čísla

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)

HEX z čísla

Čí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)

Číslo z HEX

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)

Číslo z RGB

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)
Microsoft Excel VBA - stahuj logo

Ke stažení

Soubor ke stažení zdarma je v přípravě. Podpořit zveřejnění můžete podporou na Patreon.


Závěrem

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

Odměna

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.


Pavel Lasák - autor webu

Pavel Lasák

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ů.

   Pavel Lasák LinkedIn Profil    Pavel Lasák Google+ Profil    Pavel Lasák facebook Profil    Pavel Lasák twitter Profil


Komentáře zatím nejsou

Můžete být prvními co zanechají smysluplný komentář.






Excel


Sdílejte

Pomohl Vám návod?
Sdílejte na Facebooku, G+
LinkedIn...

Nové články


Reklama


TOPlist Licence Creative Commons webarchiv rss XML

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 |