I'm trying to set the interior color of some cells using HSL instead of RGB.
Judging by this documentation from Microsoft, it's very simple:
https://learn.microsoft.com/en-us/office/client-developer/visio/hsl-function
The syntax is simply HSL(** hue **, ** saturation **, ** luminosity ** )
Why, then, is my VBA telling me the sub or function is not defined?
The same error occurs for both of these lines of code:
Range("A1").Interior.Color = HSL(160, 240, 120)
Range("A1").Interior.ColorIndex = HSL(160, 240, 120)
Here's an alternative method for converting between RGB → HSL in VBA, using a Windows API. Since it's a "Classic Windows" function it has a couple idiosyncrasies.
RGB to HSL with ColorRGBToHLS
ColorRGBToHLS is an Windows API function which therefore uses an outdated color range that's been carried forward since the 1980's (originally used in a long-defunct program called MS Chart). You may be familiar with converting R/G/B values between percentages and values out of 255.
However in this case the conversion must be to/from values out of 240, not 255.
Just to further confuse us here in the future, they used notation of HLS instead of more-common HSL (and hex color strings are 0xBBGGRR instead of #RRGGBB).
tl;dr
Option Explicit
Public Declare PtrSafe Sub ColorRGBToHLS Lib "shlwapi.dll" (ByVal clrRGB As Long, _
wHue As Integer, wLuminance As Integer, wSaturation As Integer)
Function rgb_to_hsl(r As Integer, g As Integer, b As Integer)
Dim h As Integer, s As Integer, l As Integer
ColorRGBToHLS RGB(r, g, b), h, l, s
h = 360 * (h / 239)
s = 100 * (s / 240)
l = 100 * (l / 240)
rgb_to_hsl = "hsl(" & h & "," & s & "%," & l & "%)"
End Function
...and a demo:
Sub test()
Debug.Print rgb_to_hsl(255, 180, 63) 'returns "hsl(36,100%,62%)"
End Sub
By the way the API also has a ColorHLSToRGB function.
The 80's was a crazy (often confusing) time for computer nerds. Fun fact: Bill Gates married the first female programmer he hired.
Related
So I'm new to VBA and it has been a long time since I had to program something like this. I'm trying to use six different inputs to format cells. Right now, if I could just get the inputs in x, y, z to format the corresponding cell, that would be great! I'm trying to avoid writing over 125 different if statements or cases and need a way to copy whatever color is in the B column to the appropriate x, y, z box. How can I do this iteratively?
Example
Edit: Basically what I'm trying to do is locate a cell that corresponds to an x, y, z input. Right now, the l, w, h don't matter. I'm just trying to go through all the cells in the z-planes and to find the one that matches the three input conditions (x,y,z).
Unfinished but, this should get you started in the right direction.
This will add your 3d object to an array.
AddValue will insert a value in the array at the appropriate locations
PostArray will display the array at a given location.
Note: There is no error checking in either function.
Your example Height (named depth in mine) is incorrect for sub_3. If height 0 shows on a single depth, then 3 should show on 4 depths (the starting depth extended 3 depth layers). Much like length and width values of 1 extend one past the original position.
Sub Test()
Dim oArr(1 To 5, 1 To 5, 1 To 5) As String
Call AddValue(oArr, 4, 4, 1, 0, 0, 0, "s1")
Call AddValue(oArr, 1, 3, 2, 0, 0, 0, "s2")
Call AddValue(oArr, 2, 2, 1, 1, 1, 3, "s3")
Call PostArray(oArr, Sheet1.Range("I4"))
End Sub
Private Sub AddValue(ByRef Arr() As String, ByVal iX As Integer, ByVal iY As Integer, ByVal iZ As Integer, _
ByVal iLength As Integer, ByVal iWidth As Integer, iDepth As Integer, _
ByVal Value As String)
Dim oLength As Integer
Dim oWidth As Integer
Dim oDepth As Integer
For oLength = iX To iX + iLength
For oWidth = iY To iY + iWidth
For oDepth = iZ To iZ + iDepth
Arr(oLength, oWidth, oDepth) = Value
Next
Next
Next
End Sub
Private Sub PostArray(ByRef Arr() As String, ByVal PostRange As Range)
Dim oX As Integer
Dim oY As Integer
Dim oZ As Integer
For oX = 1 To 5
For oY = 1 To 5
For oZ = 1 To 5
PostRange.Offset(oX - 1, (oY - 1) + ((oZ - 1) * 6)).Value = Arr(oX, oY, oZ)
Next
Next
Next
End Sub
Additional work
PostArray values from are going left to right, rather than your example of Right to left. If you read from right to left in your grids why arn't the depths also listed in the same direction? If you need it in that order, you'll likely want to separate the math to get the cooridinate of the 1,1 position for each depth, and a separate calculation for the offsets within that grid.
PostArray listed values instead of color, but if you enter the color as your value for each position you could set the color instead of posting the value.
Will need a loop to call AddValue using values from your worksheet rather than manually entering them into an array.
I've done a bit of searching for this one and cannot find the answer (or maybe looking in the wrong places :/)
I am trying to find a reference for the colour values used in excel VBA. I have a few simple lines of code which change the background colour in a selected cell (in this case I am using a simple macro to invoke the code).
I have a come across this value which was generated by the macro recorder:
Selection.Interior.Color = 15773696
My preference is to use RGB (the RGB equivalent of the above example is 128, 128, 128) and I have been trying find out where the macro recorder got this value from.
Apologies if this is a FAQ.
TIA
To convert the output in the terms of RGB:
Option Explicit
Public Sub ConvertColor()
Convert2RGB 15773696
End Sub
Public Sub Convert2RGB(ByVal clr As Long)
Dim R As Long, G As Long, B As Long
R = clr Mod 256
G = clr \ 256 Mod 256
B = clr \ 65536 Mod 256
'Or
'R = clr And 255
'G = clr \ 256 And 255
'B = clr \ 256 ^ 2 And 255
Debug.Print "R:" & R & " G:" & G & " B:" & B '15773696 -> R:0 G:176 B:240
Debug.Print RGB(R, G, B) 'R:0 G:176 B:240 -> 15773696
End Sub
From SO: Return RGB values from Range.Interior.Color (or any other Color Property)
...The number is a mathematical combination of the RGB values (B256^2 +
G256 + R) and a conversion of the hex color value to a decimal number
(base 16 to base 10)...
...a decimal conversion of the typical hexidecimal numbers that we are
used to seeing for colors in html e.g. "66FF66"...
More details (external link): Determining the RGB Value of a Color
First of all I need to point out that I have never coded Visual Basic before.
I have an old spreadsheet which has some functions that are apparently written in Visual Basic. An example functions is:
Function Helmert_X(X, Y, Z, DX, Y_Rot, Z_Rot, s)
'Computed Helmert transformed X coordinate.
'Input: - _
cartesian XYZ coords (X,Y,Z), X translation (DX) all in meters ; _
Y and Z rotations in seconds of arc (Y_Rot, Z_Rot) and scale in ppm (s).
'Convert rotations to radians and ppm scale to a factor
Pi = 3.14159265358979
sfactor = s * 0.000001
RadY_Rot = (Y_Rot / 3600) * (Pi / 180)
RadZ_Rot = (Z_Rot / 3600) * (Pi / 180)
'Compute transformed X coord
Helmert_X = X + (X * sfactor) - (Y * RadZ_Rot) + (Z * RadY_Rot) + DX
End Function
I'm trying to convert these functions into C. I have almost finished but what I would like to do is to build a visual basic project that calls the functions with various parameters. Then I will have a C project which uses the same parameters and checks that the C gets the same answers as the Visual Basic.
When I put the Visual Basic functions into a Module in Visual Studio I get a lot of errors. Firstly the comments don't all register as comments, and the variables apparently need to be declared.
Am I using the functions properly? Is there anyway to use them in code without modifying them? Could I use Excel to run test parameters through the functions?
It seems you need to declare all variables that exist in that function. Try to add theses lines after the comments:
Dim Pi As Double
Dim sfactor As Double
Dim RadY_Rot As Double
Dim RadZ_Rot As Double
You can also specify type for variables that came with function, as well the function itself:
Function Helmert_X(X as Double, Y as Double, Z as Double, DX as Double, Y_Rot as Double, Z_Rot as Double, s as Double) as Double
Let me know if it works or if there is still some issue.
Public Function foo()
Dim x As Double, y As Double, z As Double
x = 1.26
y = 3.175
z = Round(x + y, 2)
foo = z
End Function
Running Excel 2007 on Windows 7. This function returns 4.43 into a cell with =foo() which is annoying as I want 4.44. I found some documentation claiming VBA ROUND uses even rounding but here the last digit is odd. What is wrong here?
You can always use the Worksheet Round Function instead of VBA's built-in one
Public Function foo2()
Dim x As Double, y As Double, z As Double
x = 1.26
y = 3.175
z = Application.WorksheetFunction.Round(x + y, 2)
foo2 = z
End Function
foo2 will result in 4.44 (tested on my machine). I don't know if this would affect performance at all.
You will need to use decimal types to accomplish this which uses integer based arithmetic as opposed to floating point based.
Excel doesn't have a native data type for this, so you have to use a Variant and then convert to a decimal using the CDec function.
Public Function foo()
Dim x As Variant, y As Variant, z As Variant
x = CDec(1.26)
y = CDec(3.175)
z = Round(x + y, 2)
foo = z
End Function
While Excel.WorksheetFunction.Round does perform correct 4/5 rounding, it is terribly slow and, of course, requires Excel to be installed.
For fast and precise rounding of any value - up, down, 4/5, Banker's, significant digits, Base 2 or Base 10, and more - go to my project VBA.Round.
I would like to calculate heading direction from the north between 2 points with P1(lat1 , long2) and P2(lat2 long2), in excel.
It depends on what level of accuracy you are looking for. Haversine formula is simple yet may be insufficient since it assumes Earth surface is a perfect sphere (which it is not) and provides only limited accuracy.
Vincenty's formulae provide way better, geodesic grade accuracy (1.46E-6 degrees).
VBA Excel implementation I put together can be found on GitHub: https://github.com/tdjastrzebski/Vincenty-Excel.
VincentyInvFwdAzimuth() function should get you what you need.
I have a function used for ham radio calculations. A "pure" formula was too bulky for me.
Function BearingFromCoord(lat_base_deg, long_base_deg, lat_dest_deg, long_dest_deg As Single) As Long
Dim rad_deg_factor As Single
Dim long_diff As Single
Dim frac0 As Single
Dim frac1 As Single
Dim frac2 As Single
Dim lat_base As Single
Dim long_base As Single
Dim lat_dest As Single
Dim long_dest As Single
Dim bearing As Single
rad_deg_factor = 360 / (2 * pi())
long_diff = (long_base_deg - long_dest_deg) / rad_deg_factor
lat_base = lat_base_deg / rad_deg_factor
lat_dest = lat_dest_deg / rad_deg_factor
frac0 = Sin(lat_base) * Sin(lat_dest) _
+ Cos(lat_base) * Cos(lat_dest) _
* Cos(long_diff)
bearing = rad_deg_factor * Application.WorksheetFunction.Acos((Sin(lat_dest) _
- Sin(lat_base) * frac0) _
/ (Cos(lat_base) * Sin(WorksheetFunction.Acos(frac0))))
If Sin(long_diff) < 0 Then
BearingFromCoord = bearing
Else
BearingFromCoord = 360 - bearing
End If
End Function
Private Function pi() As Single
pi = 3.1415926535
End Function