Currently I am trying to populate the distance between 2 coordinates in Access. I found a VBA function online that allows me to use ACOR and RADIANS in access. The function worked, but when I attempt to "Make Table", I keep running into an error that says "Invalid Procedure Call or Argument". Keep it mind the data contains 4,000,000+ records.
Does anyone know how to fix this VBA issue?
Below is the code
Const pi = 3.14159265358979
Function ACos(ang As Double) As Double
If Abs(ang) <> 1 Then
ACos = pi / 2 - Atn(ang / Sqr(1 - ang * ang))
ElseIf ang = -1 Then
ACos = pi
End If
End Function
Function Radians(ang As Double) As Double
Radians = ang * pi / 180
End Function
Also below is the Make Table Code:
Distance: ACOS(Cos(RADIANS(90-[Latitude]))*Cos(RADIANS(90-[Dlatitude]))+Sin(RADIANS(90-[DLatitude]))*Sin(RADIANS(90-[DLatitude]))*Cos(RADIANS([Longitude]-[DLongitude])))*3858
Related
I am new to VBA for word. For a particular purpose, I wanted to move the cursor to the end of the document, while searching the net I found the following code snippet.
Selection.EndKey Unit:=wdStory
, Here my specific question is what is this wdStory? When I searched for this, I got hundreds of such things named enumerations , I want to know why they are used and what does this line interpret to the compiler .
Consider the following sophisticated function (I demand full credit)
Function ConvertLength(dLength As Double, iOption As Integer) As Double
If iOption = 0 Then ' from km to m
ConvertLength = dLength * 1000
ElseIf iOption = 1 Then ' from m to km
ConvertLength = dLength / 1000
ElseIf iOption = 2 Then ' from m to cm
ConvertLength = dLength * 100
ElseIf iOption = 3 Then ' from cm to m
ConvertLength = dLength / 100
End If
End Function
Now we have a problem: Almost every time we use this function we have to consult the documentation to figure out which option to use. For example to convert a length from meters to centimeters, we need to use option 2 and the call would be
newVal = ConvertLength(oldVal, 2)
Not only is this a nightmare at development time, but every time we read this line, we have to remind ourselves what this option 2 is.
This is where enumerations shine. In this case we would define an enumeration as follows:
Enum ConvertOptions
KmToMeters = 0
Meters2Km = 1
Meters2cm = 2
cmToMeters = 3
End Enum
and the function would be re-implemented as
Function ConvertLength2(dLength As Double, iOption As ConvertOptions) As Double
If iOption = KmToMeters Then
ConvertLength = dLength * 1000
ElseIf iOption = Meters2Km Then
ConvertLength = dLength / 1000
ElseIf iOption = Meters2cm Then
ConvertLength = dLength * 100
ElseIf iOption = cmToMeters Then
ConvertLength = dLength / 100
End If
End Function
and we simply use this new function like this
newVal2 = ConvertLength2(oldVal, Meters2cm)
Here the compiler sees the value 2 instead of Meters2cm
Not only is this code much more readable, but the VB editor actually autocompletes our code for us.
Now, isn't that nice?!
Just like this custom enumeration, word (excel, powerpoint etc) VBA is full of these enumerations (constants). We can safely think of them as integer options we pass to built-in functions/methods to achieve what we want.
Finally if you want to know what a "story" is, read this
This question already has answers here:
type-declaration character does not match declared data type
(2 answers)
Closed 2 years ago.
N1 = 3
N2 = 4
N3 = Sqr(N1^(2) + N2^(2)) 'N3 is the hypotenuse
MsgBox N3
I get the following error and N1^ is highlight.
There seems to be some issues with the power operator, please refer to this thread:
VBA power operator (^) not working as expected in 64-bit VBA
Also temporary fix to this issue mentioned in this thread, use the below function to calculate power:
Excel.WorksheetFunction.Power(N1, 2)
Edit: for Powerpoint VBA, I'm not sure if there's a library function that would calculate the power, but for integer type of power number, we can simply wrap a loop into a function:
Public Function myPower(base As Double, pow As Long) As Double
Dim ret As Double: ret = 1
If pow > 0 Then
For i = 1 To pow
ret = ret * base
Next i
Else
For i = -1 To pow Step -1
ret = ret / base
Next i
End If
myPower = ret
End Function
For floating point power number... I'll have to go back and check the formula....
Second Edit: I just tested putting parenthesis on the variables then using caret, seems to be working on my 64bit Excel, maybe you should try this in PowerPoint first :)
Public Sub test()
N1 = 3
N2 = 4
N3 = Sqr((N1) ^ 2 + (N2) ^ 2)
MsgBox N3
End Sub
How to implement the VBA code of the arcsin function (defined below)?
Definition: The arcsin function is the inverse of the sine function. It returns the angle whose sine is a given number. For every trigonometry function, there is an inverse function that works in reverse. These inverse functions have the same name but with 'arc' in front. (On some calculators the arcsin button may be labelled asin, or sometimes sin-1.) So the inverse of sin is arcsin etc. When we see "arcsin A", we understand it as "the angle whose sin is A"
sin30 = 0.5 Means: The sine of 30 degrees is 0.5
arcsin 0.5 = 30 Means: The angle whose sin is 0.5 is 30 degrees.
I don't really understand your question here. The arcsin function already exists in VBA, you can use it with :
WorksheetFunction.Asin(myValue)
Use of the arcsin function
Dim myValue As Double
myValue = 0.1234
MsgBox CStr(WorksheetFunction.Asin(myValue))
There you can print the result of the arcsin function for a value as Double.
The following code will help to implement the ARCSIN function based on given definition:
Option Explicit
Public Const Pi As Double = 3.14159265358979
Private Function ArcSin(X As Double) As Double
If Abs(X) = 1 Then
'The VBA Sgn function returns an integer (+1, 0 or -1),
'representing the arithmetic sign of a supplied number.
ArcSin = Sgn(X) * Pi / 2
Else
'Atn is the inverse trigonometric function of Tan,
'which takes an angle as its argument and returns
'the ratio of two sides of a right triangle
ArcSin = Atn(X / Sqr(1 - X ^ 2))
End If
End Function
Please bear with me I´m a newbie in programming and I´m trying to learn how to rotate a 3D point (XYZ) around 0,0,0 and later I´ll try to improve my code to allow rotation around an arbitrary point (XYZ).
I´m starting with VB and after extensive searches here and in the Web, I could not find an explanation for my problem. I´m an almost 40 years old trying to learn math and programming, so please bear with me because it will take time for me to digest all the math side for these problems.
Basically, I´m trying to write an algorithm to rotate a 3D point, however, while it seems that with some angles my code works, with some others I just get weird funky numbers that are probable correct in some aspect, but I can´t find the flaw in the code. I´ve been looking into this for days and tried multiple approaches, but I´m just not being able to spot the error.
This is the UI for my little app. The original coordinates are entered in the top of the form, and in the bottom of the form I show the rotated coordinates.
Notice that in the image below, a simple rotation of a coordinate of Y10.0 around Z axis by 90 degrees return a correct X value (-10), but Y shows a funky number (6.1230...)... However if I change the rotation angle around Z to 45, the results seems to be correct...
I don´t know what I´m doing wrong to get this weird Y. Because of this error, I´m not trusting in the results of this algorithm at all but I´m currently in a blindspot...
This is the code of the calculate button:
Private Sub BtnCompute_Click(sender As Object, e As EventArgs) Handles BtnCompute.Click
'Capture the values from the text boxes and parse then to doubles
ValidateAllFieldsWithDoubleValues()
'Rotate the coordinates
RotateXYZCoordinates(dblOriginalCoordX, dblOriginalCoordY, dblOriginalCoordZ, dblCurrentRotationAroundX, dblCurrentRotationAroundY, dblCurrentRotationAroundZ)
'Update the text boxes for the rotated coordinates for XYZ
txtResultX.Text = dblResultX.ToString
txtResultY.Text = dblResultY.ToString
txtResultZ.Text = dblResultZ.ToString
End Sub
And this is the code of the function that calculates the rotations:
Private Function RotateXYZCoordinates(ByVal XCoord As Double, ByVal YCoord As Double, ByVal ZCoord As Double, ByVal Pitch As Double, ByVal Roll As Double, ByVal Yaw As Double)
'X Rotation
Dim RadPitch As Double = 0
Dim CosPitch As Double = 0
Dim SinPitch As Double = 0
Dim XRotatedAroundX As Double = 0
Dim YRotatedAroundX As Double = 0
Dim ZRotatedAroundX As Double = 0
RadPitch = Pitch * Math.PI / 180
CosPitch = Math.Cos(RadPitch)
SinPitch = Math.Sin(RadPitch)
XRotatedAroundX = XCoord
YRotatedAroundX = YCoord * CosPitch - ZCoord * SinPitch
ZRotatedAroundX = YCoord * SinPitch + ZCoord * CosPitch
'Y Rotation
Dim RadRoll As Double = 0
Dim CosRoll As Double = 0
Dim SinRoll As Double = 0
Dim XRotatedAroundY As Double = 0
Dim YRotatedAroundY As Double = 0
Dim ZRotatedAroundY As Double = 0
RadRoll = Roll * Math.PI / 180
CosRoll = Math.Cos(RadRoll)
SinRoll = Math.Sin(RadRoll)
XRotatedAroundY = ZRotatedAroundX * CosRoll - XRotatedAroundX * SinRoll
YRotatedAroundY = YRotatedAroundX
ZRotatedAroundY = ZRotatedAroundX * SinRoll + XRotatedAroundX * CosRoll
'Z Rotation
Dim RadYaw As Double = 0
Dim CosYaw As Double = 0
Dim SinYaw As Double = 0
Dim XRotatedAroundZ As Double = 0
Dim YRotatedAroundZ As Double = 0
Dim ZRotatedAroundZ As Double = 0
RadYaw = Yaw * Math.PI / 180
CosYaw = Math.Cos(RadYaw)
SinYaw = Math.Sin(RadYaw)
XRotatedAroundZ = XRotatedAroundY * CosYaw - YRotatedAroundY * SinYaw
YRotatedAroundZ = XRotatedAroundY * SinYaw + YRotatedAroundY * CosYaw
ZRotatedAroundZ = ZRotatedAroundY
'Final result
dblResultX = XRotatedAroundZ
dblResultY = YRotatedAroundZ
dblResultZ = ZRotatedAroundZ
Return Nothing
End Function
I know this is not an elegant code but it is what I can code for now... I´d appreciate if someone could take a look at this and point me to the source of error... I´ve been watching videos and did an extensive search in this website before I posted... But it seems some things are still very advanced to me for now... I´m not lazy and I´m willing to learn if someone point me towards something I could digest for now...
If someone could share a hint about how to make this rotate function to support rotation around a point other than 0,0,0 I´d appreciate.
Thank you,
Daniel
The answer is correct. Due to double precision math and a 90 degree rotation there is a limit to the accuracy. The answer is really 6.12303176911189E-16 or .000000000000000612303176911189. Round the number off to a realistic value of decimal points. This is also why 1+1 is not equal to 2 but 1.999999999999999999999999999999 in floating point math.
I am really a freshman to study the VBA. I am confused about how to add an error message in a function subroutines.
Here is my problem, when I finished identify a function, how can I add an error message like this: "Please enter the value in an increasing order"?
e.g: If I type =triangular(3,2,1), where the number is in a decreasing order, I should get an error message.
Here is my code:
Public Function triangular(Minimum As Single, mostlikelyvalue As Single, maximum As Single) As Single
Dim uniform As Single
Dim d As Single
Randomize
Application.Volatile
d = (mostlikelyvalue - Minimum) / (maximum - Minimum)
uniform = Rnd
If uniform <= d Then
triangular = Minimum + (maximum - Minimum) * Sqr(d * uniform)
Else
triangular = Minimum + (maximum - Minimum) * (1 - Sqr((1 - d) * (1 - uniform)))
End If
End Function
You can test for incorrect order, or also an invalid entry directly in your function and return that rather than use error handling
Changed variable names to help avoid errors and confusion with existing function
Use a variant function to hold either the result or one of the two customised error messages
You may as well use Doubles rather than Singles
code
Public Function triangular(dbMinimum As Double, dbMostlikelyvalue As Double, dbMaximum As Double)
Dim uniform As Double
Dim d As Double
Dim dbCnt As Double
dbCnt = dbMinimum * dbMostlikelyvalue * dbMaximum
If dbCnt = 0 Then
triangular = "at least one value is zero"
Exit Function
End If
If dbMostlikelyvalue > dbMaximum Or dbMinimum > dbMostlikelyvalue Then
triangular = "values not sorted"
Exit Function
End If
Randomize
Application.Volatile
d = (dbMostlikelyvalue - dbMinimum) / (dbMaximum - dbMinimum)
uniform = Rnd
If uniform <= d Then
triangular = dbMinimum + (dbMaximum - dbMinimum) * Sqr(d * uniform)
Else
triangular = dbMinimum + (dbMaximum - dbMinimum) * (1 - Sqr((1 - d) * (1 - uniform)))
End If
End Function
Try this
Public Sub Sample
On Error Goto Err
'call your function here
'some more codes here
Exit Sub 'if all goes well code ends here
Err: 'Error handler
MsgBox Err.Description
End Sub