I am trying to do calculations through VBA.
I am doing it through the form itself because when Production creates one of these Job Tickets a number of fields can change on the fly. Which Unit of Measure we are running in, which type of Wood, how we Wrap it, etc.
All of these changes affect the total footage or amount of pieces we have to run, which is why I have If-Then-Else statements for them.
It works until I get to Wrap SQ Footage. I get a zero inserted into my field, but when I do the calculations on my own I never get 0.
I created this expression in the control source of one of the Wrap SQ Footages, and it comes out correctly.
=Abs(Int( (([Wrap_Slit1]/12) * [Quantity_Ordered] ) * ( [RIP_Scrap_Rate] + 1))))
Private Sub FTG_Calculations()
'Declare Variable
Dim L As Double
Dim Length As Double
Dim OrderFTG As Double
Dim UoM As String
Dim W As Double
Dim frm As Access.Form
Set frm = Forms!Frm_JobTicket
'Set L equal to Length from Tbl_JobTicketMould
L = DLookup("Length", "Tbl_JobTicketMould", "Access_ID =" & Forms!Frm_JobTicket!Part_Number)
'Convert Length to Feet
Length = (L \ 12)
'Find Unit of Measure for this part
UoM = DLookup("Unit_of_Measure", "Tbl_JobTicketUoM", "Access_ID =" & Forms!Frm_JobTicket!Part_Number)
'Mupltiply Length times Quantity to get Order Footage
OrderFTG = Int((Length * Me.Txt_Pcs_JobTicket))
'If UoM is PCS then insert that number. Otherwise set equal to Quantity Ordered divided by Length of piece(in FT)
If UoM = "PCS" Then Me.Txt_Pcs_JobTicket = Me.Quantity_Ordered Else: Me.Txt_Pcs_JobTicket = Abs(Int(Me.Quantity_Ordered \ Length))
'Define limits of the loop. Then runs through all Wrap SQ FTG fields and inputs calculation
For W = 1 To 3
'If UoM is PCS then calculate Order Footage to find Wrap Sqaure Footage. Otherwise take slit size in FT and multiply by Order Quantity and Scrap Rate
If UoM = "PCS" Then
frm("Txt_Wrap" & W & "SQFTG_JobTicket") = (((frm("Wrap_Slit" & W) \ 12) * OrderFTG) * (Round((frm("RIP_Scrap_Rate")), 3) + 1))
Else: frm("Txt_Wrap" & W & "SQFTG_JobTicket") = (((frm("Wrap_Slit" & W) \ 12) * frm(Quantity_Ordered)) * (frm(RIP_Scrap_Rate + 1)))
End If
Next W
I figured out the issue is in the (frm("Wrap_Slit" & W) \ 12) area. Wrap_Slit1 shows a value of 2 in the data tips, but when I divide by 12 it comes out to 0.
All of my data points are set to double, and the variables are declared as double. It is rounding down when it should come out to .16667.
Place the following code before the:
If UoM = "PCS" Then
Msgbox code:
MsgBox("Current State:" & vbCrLf & _
"UoM:" & vbTab & UoM & vbCrlf & _
"OrderFTGL" & vbTab & OrderFTG & _
"Wrap_Slit1:" & vbTab & Me.Wrap_Slit1 & _
... continue pattern for other desired values in calculation...
"Continue...", vbOK)
this is my first time posting! So I created a database on ms access that helps in invoicing and helps to create and analyse data. I wanted to simplify it and add code to it. One of the modules that I created is the following one, it takes four numbers as input, three of them have a default value of 0, if they are anything other than zero then it is supposed to concatenate them. I believe( atleast hope) the module is correct, but when I add it to the form, it displays an error "?Name".
Thanks in advance! :-)
This is the code:
Function MultiApart(ApOne As Single, ApTwo As Single, ApThree As Single, ApFour As Single) As String
Dim a As String
Dim b As String
Dim c As String
Dim d As String
a = CStr(ApOne)
b = CStr(ApTwo)
c = CStr(ApThree)
d = CStr(ApFour)
MultiApart = a
If (ApTwo > 0#) Then MultiApart = MultiApart & ", " & b
If (ApThree > 0#) Then MultiApart = MultiApart & ", " & c
If (ApFour > 0#) Then MultiApart = MultiApart & ", " & d
End Function
My goal is to find a way to call Fortran subroutine in Excel VBA (can be found on Prof Alan Genz. The program is MVNPACK) to compute the CDF of multivariate normal distribution. Ideally, I would like to be able to use a version of DLL compiled from that source code in a C# project as well in the future. However, I am not sure how to troubleshoot and proceed further. I typically code in Python, have some exposure in C, Java, etc., but never use Fortran and not too familiar with what's going on when one calls a function in a DLL. To the best of my knowledge, this computation is not that widely available, and compiling the Fortran source code is my best bet.
I have been closely following the example here about creating the DLL, and here about using that in Excel VBA, and been trying to mimic the result. Starting from the MVNPACK source code mentioned above, I figured that what I need is to pass the inputs to the subroutine MVNDST, and get the result back by passing the pointers as arguments to the subroutine. So the first thing I did was trying to modify the code based on what the examples did. My modified version MVNDSTC looks like this.
SUBROUTINE MVNDSTC( N, LOWERC, UPPERC, INFINC, CORRELC, MAXPTS,
& ABSEPS, RELEPS, ERRORC, VALUEC, INFORMC)
& bind(c)
use ISO_C_BINDING
implicit none
cGCC$ ATTRIBUTES STDCALL, DLLEXPORT :: MVNDSTC
EXTERNAL MVNDFN
integer(kind=c_long), value:: N, MAXPTS
real(kind=c_double), value:: ABSEPS, RELEPS
type(c_ptr), value:: LOWERC, UPPERC, INFINC, CORRELC
type(c_ptr), value:: ERRORC, VALUEC, INFORMC
real(kind=c_double), dimension(:), pointer:: LOWER, UPPER, CORREL
integer(kind=c_long), dimension(:), pointer:: INFIN
real(kind=c_double), dimension(:), pointer:: ERROR_OUT, VALUE_OUT
integer(kind=c_int), dimension(:), pointer:: INFORM_OUT
INTEGER NN
INTEGER INFORM, INFIS, IVLS
DOUBLE PRECISION ERROR, VALUE, E, D, MVNDNT, MVNDFN
COMMON /DKBLCK/IVLS
NN = (N - 1) * N / 2
call C_F_POINTER(LOWERC, LOWER, [N])
call C_F_POINTER(UPPERC, UPPER, [N])
call C_F_POINTER(INFINC, INFIN, [N])
call C_F_POINTER(CORRELC, CORREL, [NN])
call C_F_POINTER(ERRORC, ERROR_OUT, [1])
call C_F_POINTER(VALUEC, VALUE_OUT, [1])
call C_F_POINTER(INFORMC, INFORM_OUT, [1])
IF ( N .GT. 500 .OR. N .LT. 1 ) THEN
INFORM = 2
VALUE = 0
ERROR = 1
ELSE
INFORM = MVNDNT(N, CORREL, LOWER, UPPER, INFIN, INFIS, D, E)
IF ( N-INFIS .EQ. 0 ) THEN
VALUE = 1
ERROR = 0
ELSE IF ( N-INFIS .EQ. 1 ) THEN
VALUE = E - D
ERROR = 2D-16
ELSE
*
* Call the lattice rule integration subroutine
*
IVLS = 0
CALL DKBVRC( N-INFIS-1, IVLS, MAXPTS, MVNDFN,
& ABSEPS, RELEPS, ERROR, VALUE, INFORM )
ENDIF
ENDIF
VALUE_OUT(0) = VALUE
ERROR_OUT(0) = ERROR
INFORM_OUT(0) = INFORM
END
Then I created a small subroutine with the mvndstc declaration on top. The VBA code is as follows.
Private Declare PtrSafe Sub mvndstc Lib "C:\Users\poopa\Desktop\mvn\mvn_project\fortran-library.dll" _
(ByVal N As Integer, _
ByRef LOWER As Single, _
ByRef UPPER As Single, _
ByRef INFIN As Single, _
ByRef CORREL As Single, _
ByVal MAXPTS As Integer, _
ByVal ABSEPS As Double, _
ByVal RELEPS As Double, _
ByRef ERROR As Single, _
ByRef VALUE As Single, _
ByRef INFORM As Single)
Sub mvn_test()
Dim value_1(1 To 1) As Single ' Result of the function
Dim inform_1(1 To 1) As Single ' Information
Dim error_1(1 To 1) As Single ' Error estimate
Dim upper_1() As Single
Dim lower_1() As Single
Dim infin_1() As Single
Dim correl_1() As Single
Dim n_1 As Long, n_1_2 As Long, max_pts_1 As Long
n_1 = 5
ReDim lower_1(1 To n_1)
ReDim upper_1(1 To n_1)
ReDim infin_1(1 To n_1)
lower_1(1) = 0#
lower_1(2) = 0#
lower_1(3) = 1.7817
lower_1(4) = 0.14755
lower_1(5) = 0#
upper_1(1) = 0#
upper_1(2) = 1.5198
upper_1(3) = 0#
upper_1(4) = 0#
upper_1(5) = 1.5949
infin_1(1) = 1
infin_1(2) = 2
infin_1(3) = 1
infin_1(4) = 1
infin_1(5) = 0
n_1_2 = Int(n_1 / 2 * (n_1 - 1))
ReDim correl_1(1 To n_1_2)
correl_1(1) = -0.707107 ' 12
correl_1(2) = 0# ' 13
correl_1(3) = 0.5 ' 14
correl_1(4) = 0# ' 15
correl_1(5) = 0.5 ' 23
correl_1(6) = 0.5 ' 24
correl_1(7) = 0# ' 25
correl_1(8) = 0.5 ' 34
correl_1(9) = 0.5 ' 35
correl_1(10) = 0.5 ' 45
max_pts_1 = 625000
mvndstc n_1, lower_1(1), upper_1(1), infin_1(1), correl_1(1), max_pts_1, 0.00005, 0, error_1(1), value_1(1), inform_1(1)
Debug.Print "Value = " & (value_1(1))
Debug.Print "Error Est = " & (error_1(1))
Debug.Print "Inform = " & inform_1(1)
End Sub
Now my first attempt I did not modify ERROR, VALUE, INFORM parameters at all and simply declare then in Fortran as theirs respective primitive types. I can actually run the VBA subroutine, but I got all zeros for the results. So I was speculating that the program runs but perhaps I didn't get the result back properly and I should treat these three outputs as pointers with size of 1. That way I just keep whatever procedure exactly the same in Fortran and then if I put VALUE_OUT(0) = VALUE and so on, before the function ends I should be get the results just fine. Right now using the code I posted here, I can actually see the results printed out in VBA, still all zeros, but right after that Excel would immediately crash.
So I want to ask how do I proceed from here? What did I got wrong here? Is there any resource worth looking into?
Thanks in advance.
I fixed this yesterday, the problem is indeed about the data types. When I read the tutorial I was assuming Single is some kind of object type in VBA. Little did I know that Single is actually the single precision of Double! I tried debugging all this by letting the DLL print out all the values inside the function to a file.
I am getting an interesting result when executing the following VB script.
Set StdOut = WScript.StdOut
Set wbemSvc = GetObject("winmgmts://" & "." & "/root/cimv2")
Set biosSet = wbemSvc.ExecQuery("Select * from Win32_BIOS")
For Each biosObj In biosSet
StdOut.WriteLine "SMBIOSMajorVersion=" & biosObj.SMBIOSMajorVersion
StdOut.WriteLine "SMBIOSMinorVersion=" & biosObj.SMBIOSMinorVersion
Next
StdOut.WriteLine "Return value is: " & IsNewBiosVersion
Function IsNewBiosVersion()
On Error Resume Next
Set biosSet = wbemSvc.ExecQuery("Select * from Win32_BIOS")
newBios = 0
For Each bios In biosSet
minorFloat = "." & bios.SMBIOSMinorVersion
If bios.SMBIOSMajorVersion > 2 OR (bios.SMBIOSMajorVersion = 2 AND minorFloat >= .6) Then
newBios = 1
End If
Next
IsNewBiosVersion = newBios
End Function
The result is as follow. This looks contradictory since the SMBIOSMinorVersion=4, according to the code logic in the script, the return value should be 0!!!
SMBIOSMajorVersion=2
SMBIOSMinorVersion=4
Return value is: 1
I ran this same script on another system and got the expected correct result.
SMBIOSMajorVersion=2
SMBIOSMinorVersion=4
Return value is: 0
So what is the problem here?
New update:
We execute the following script again on the system, and found that the CDbl() function does not convert the string "2.4" to double value correctly, instead it converts it to 24! Looks like the dot "." was lost when converting, what is wrong with this? An bug in CDbl or a violation when use it?
here is the script
Set StdOut = WScript.StdOut
StdOut.WriteLine ""
StdOut.WriteLine "Simple Function to Test BIOS Version"
StdOut.WriteLine ""
Set wbemSvc = GetObject("winmgmts://" & "." & "/root/cimv2")
Set biosSet = wbemSvc.ExecQuery("Select * from Win32_BIOS")
For Each bios In biosSet
newBios = 0
StdOut.WriteLine "SMBIOSMajorVersion=" & bios.SMBIOSMajorVersion
StdOut.WriteLine "SMBIOSMinorVersion=" & bios.SMBIOSMinorVersion
temp = bios.SMBIOSMajorVersion & "." & bios.SMBIOSMinorVersion
StdOut.WriteLine "major dot minor=" & temp
currentBios = CDbl(bios.SMBIOSMajorVersion & "." & bios.SMBIOSMinorVersion)
StdOut.WriteLine ""
StdOut.WriteLine "currentBios=" & currentBios
If currentBios >= 2.6 Then newBios = 1
StdOut.WriteLine "return value is: " & newBios
Next
here is the output
Simple Function to Test BIOS Version
SMBIOSMajorVersion=2
SMBIOSMinorVersion=4
major dot minor=2.4
currentBios=24
return value is: 1
Remove your error handling - it s probably suppressing an issue.
On Error Resume Next ' Not a good idea
For one thing you are comparing a string to a double in these lines:
minorFloat = "." & bios.SMBIOSMinorVersion
If bios.SMBIOSMajorVersion > 2 OR (bios.SMBIOSMajorVersion = 2 AND minorFloat >= .6) Then
Why not just convert the major.minor values to floating-point for your test? You're currently doing two separate tests, with one being a string vs float comparison, which is unusual.
Maybe try this instead?
currentBios = CDbl(bios.SMBIOSMajorVersion & "." & bios.SMBIOSMinorVersion)
If currentBios >= 2.6 Then newBios = 1
You have to be careful comparing floating-point values when math operations are involved but for literal values you'll be fine.
And, as already mentioned, remove On Error Resume Next or you may never know why it works on one PC but not another.
In Classic ASP, I have an object, call it bob. This then has a property called name, with let and get methods.
I have a function as follows:
sub append(byref a, b)
a = a & b
end sub
This is simply to make it quicker to add text to a variable. I also have the same for prepend, just it is a = b & a. I know it would be simple to say bob.name = bob.name & "andy", but I tried using the above functions and neither of them work.
The way I am calling it is append bob.name, "andy". Can anyone see what is wrong with this?
Unfortunately this is a feature of VBScript. It is documented in http://msdn.microsoft.com/en-us/library/ee478101(v=vs.84).aspx under "Argument in a class". The alternative is to use a function. Here is an example illustrating the difference. You can run this from the command line using "cscript filename.vbs.
sub append (a, b)
a = a & b
end sub
function Appendix(a, b)
Appendix = a & b
end function
class ClsAA
dim m_b
dim m_a
end class
dim x(20)
a = "alpha"
b = "beta"
wscript.echo "variable works in both cases"
append a, b
wscript.echo "sub " & a
a = appendix(a, b)
wscript.echo "function " & a
x(10) = "delta"
wscript.echo "array works in both cases"
append x(10), b
wscript.echo "sub " & x(10)
x(10) = appendix( x(10), b)
wscript.echo "function " & x(10)
set objAA = new ClsAA
objAA.m_a = "gamma"
wscript.echo "Member only works in a function"
append objAA.m_a, b
wscript.echo "sub " & objAA.m_a
objAA.m_a = appendix(objAA.m_a, b)
wscript.echo "function " & objAA.m_a
Have you tried using with the keyword CALL:
call append (bob.name, "andy")
Classic ASP is fickel about ByRef and ByVal. By default it uses ByRef -- no reason to specify that. If you call a function with parenthesis (without the call), it will pass the variables as ByVal.
Alternatively, you could accomplish the same with:
function append(byref a, b)
append = a & b
end sub
bob.name = append(bob.name, "andy");
Good luck.
As this other answer correctly states, you are facing limitation of the language itself.
The only other option to achieve what you are after as far as I can see it, is to add such sub routine to the class itself:
Public Sub Append(propName, strValue)
Dim curValue, newValue
curValue = Eval("Me." & propName)
newValue = curValue & strValue
Execute("Me." & propName & " = """ & Replace(newValue, """", """""") & """")
End Sub
Then to use it:
bob.Append "name", "andy"
Less elegant, but working.