HEX Color VBA
-
- GoldLounger
- Posts: 2631
- Joined: 26 Jan 2010, 16:31
- Location: Southern California
HEX Color VBA
I'm having a challenge using VBA to lighten a HEX color #424200 by 80%. The new HEX color number generated is not even close to the color I would expect.
I found a website that produces a new HEX color number which I'm trying to replicate through VBA.
Your thoughts are appreciated.
I found a website that produces a new HEX color number which I'm trying to replicate through VBA.
Your thoughts are appreciated.
Regards,
John
John
-
- Administrator
- Posts: 78665
- Joined: 16 Jan 2010, 00:14
- Status: Microsoft MVP
- Location: Wageningen, The Netherlands
Re: HEX Color VBA
I have moved this thread from the Excel forum to the VB/VBA forum since it is not specific to Excel.
Best wishes,
Hans
Hans
-
- 4StarLounger
- Posts: 594
- Joined: 14 Nov 2012, 16:06
Re: HEX Color VBA
Code: Select all
Sub M_snb()
Cells(6, 2).Interior.TintAndShade = 0.8
End Sub
-
- Administrator
- Posts: 78665
- Joined: 16 Jan 2010, 00:14
- Status: Microsoft MVP
- Location: Wageningen, The Netherlands
Re: HEX Color VBA
I have no idea what algorithm that site uses. Here is an attempt that doesn't use Excel properties, but it doesn't produce the same result as the site you linked to.
Use like this:
Code: Select all
Function Lighten(colr As Long, perc As Double) As Long
Dim r As Long, g As Long, b As Long
r = colr Mod 256
g = (colr \ 256) Mod 256
b = (colr \ 256) \ 256
r = r + perc * (255 - r)
g = g + perc * (255 - g)
b = b + perc * (255 - b)
Lighten = RGB(r, g, b)
End Function
Code: Select all
Sub Test()
Dim ColorIn as Long, ColorOut As Long
ColorIn = &H424200
ColorOut = Lighten(ColorIn, 0.8)
Debug.Print ColorOut
End Sub
Best wishes,
Hans
Hans
-
- 4StarLounger
- Posts: 573
- Joined: 27 Jun 2021, 10:46
Re: HEX Color VBA
> no idea what algorithm
I'd hazard it is messing with the luminance, something along the lines of:
newluminance = currentluminance + lightenpercent * (240 - currentluminance) / 100
This is also pretty much the algorithm used by the ColorAdjustLuma API call.
So here's an example using the first method:
And here's an example of the second
I'd hazard it is messing with the luminance, something along the lines of:
newluminance = currentluminance + lightenpercent * (240 - currentluminance) / 100
This is also pretty much the algorithm used by the ColorAdjustLuma API call.
So here's an example using the first method:
Code: Select all
Private Declare Function ColorHLSToRGB Lib "shlwapi.dll" (ByVal wHue As Integer, ByVal wLuminance As Integer, ByVal wSaturation As Integer) As Long
Private Declare Sub ColorRGBToHLS Lib "shlwapi.dll" (ByVal clrRGB As Long, ByRef pwHue As Integer, ByRef pwLuminance As Integer, ByRef pwSaturation As Integer)
Private Function LightenRGB(crRGB As Long, lightenpercent As Integer) As Long
Dim hue As Integer
Dim luminance As Integer
Dim saturation As Integer
ColorRGBToHLS crRGB, hue, luminance, saturation 'get current hls values
LightenRGB = ColorHLSToRGB(hue, luminance + lightenpercent * (240 - luminance) / 100, saturation) 'mess with luminance and return corrected COLORREF
End Function
Code: Select all
Private Declare Function ColorAdjustLuma Lib "shlwapi.dll" (ByVal clrRGB As Long, ByVal n As Long, ByVal fscale As Long) As Long
Private Function Luma(crRGB As Long, lightenpercent As Integer, Optional fscale As Boolean = True) As Long
Luma = ColorAdjustLuma(crRGB, lightenpercent * 10, fscale) 'mess with luminance and return corrected COLORREF
End Function
-
- Administrator
- Posts: 78665
- Joined: 16 Jan 2010, 00:14
- Status: Microsoft MVP
- Location: Wageningen, The Netherlands
-
- GoldLounger
- Posts: 2631
- Joined: 26 Jan 2010, 16:31
- Location: Southern California
Re: HEX Color VBA
Hans/snb,
Thank you for your suggestions. I was using similar code to what Hans suggested but like Hans was not getting the Hex number of what I expected.
sub's suggestion appears to be changing the color in the cell to yellow but the Hex number of that yellow cell is #a6ffff (pale cyan) it should be #ffffa6 (pale yellow).
In summary, neither suggestion is returning the correct Hex number of #ffffa6.
I'll give SpeakEasy's suggestion a try.
Thank you for your suggestions. I was using similar code to what Hans suggested but like Hans was not getting the Hex number of what I expected.
sub's suggestion appears to be changing the color in the cell to yellow but the Hex number of that yellow cell is #a6ffff (pale cyan) it should be #ffffa6 (pale yellow).
In summary, neither suggestion is returning the correct Hex number of #ffffa6.
I'll give SpeakEasy's suggestion a try.
Regards,
John
John
-
- 4StarLounger
- Posts: 573
- Joined: 27 Jun 2021, 10:46
Re: HEX Color VBA
>the correct Hex number of #ffffa6
I suspect that you need to understand the difference between COLORREFs and RGB values. Both can be represented in Hex, but VBA colour functions (and the API) work with COLORREFs. The difference is basically the order of the bytes
A COLORREF is bbggrr, whilst RGB is rrggbb
I suspect that you need to understand the difference between COLORREFs and RGB values. Both can be represented in Hex, but VBA colour functions (and the API) work with COLORREFs. The difference is basically the order of the bytes
A COLORREF is bbggrr, whilst RGB is rrggbb
-
- GoldLounger
- Posts: 2631
- Joined: 26 Jan 2010, 16:31
- Location: Southern California
Re: HEX Color VBA
Hans, sub, SpeakEasy,
I was able to develop VBA based on your suggestions. I have attached a sample workbook containing the code.
I was able to develop VBA based on your suggestions. I have attached a sample workbook containing the code.
You do not have the required permissions to view the files attached to this post.
Regards,
John
John
-
- 4StarLounger
- Posts: 594
- Joined: 14 Nov 2012, 16:06
Re: HEX Color VBA
I made:
In your file:
Code: Select all
Sub M_snb()
With Cells(6, 2).Interior
.Color = &H424200
.TintAndShade = 0.8
.Color = RGB(.Color \ 256 ^ 2, (.Color Mod 256 ^ 2) \ 256, .Color Mod 256)
End With
End Sub
Code: Select all
Sub M_Process_List()
sn = Range("hexlist")
For j = 1 To UBound(sn)
With Cells(j + 1, 13).Interior
.Color = Replace(sn(j, 1), "#", "&h")
.TintAndShade = 0.8
.Color = RGB(.Color \ 256 ^ 2, (.Color Mod 256 ^ 2) \ 255, .Color Mod 256)
.Parent.Offset(, 1) = Hex(.Color)
.Parent.Offset(, 2) = .Color \ 256 ^ 2 & ", " & (.Color Mod 256 ^ 2) \ 256 & ", " & .Color Mod 256
End With
Next
End Sub
-
- 4StarLounger
- Posts: 573
- Joined: 27 Jun 2021, 10:46
Re: HEX Color VBA
Here's a quick utility that will swap between COLORREF and RGB Hex that might prove useful
Code: Select all
Option Explicit
Public Type ColourBytes
r As Byte
g As Byte
b As Byte
a As Byte ' always 0, whether representing COLORREF or RGB
End Type
Public Type ColourWord
dword As Long
End Type
' Swaps a long representing a COLORREF to the RGB Hex value and vice versa
Public Function Swap(Source As Long) As Long
Dim cw As ColourWord
Dim cb As ColourBytes
cw.dword = Source
LSet cb = cw
cb.r = cb.r Xor cb.b
cb.b = cb.r Xor cb.b
cb.r = cb.r Xor cb.b
LSet cw = cb
Swap = cw.dword
End Function
Last edited by SpeakEasy on 10 Jan 2024, 16:06, edited 2 times in total.
-
- Administrator
- Posts: 78665
- Joined: 16 Jan 2010, 00:14
- Status: Microsoft MVP
- Location: Wageningen, The Netherlands