Applying one Event to multiple Elements [duplicate] - forms

I'm trying to create a dynamic function that's based off on what dropdown you interact with on a form. I need to pass the name of the dropdown to the function along with the form name when I call it.
Here's my current setup which only calls the funciton that passes the form name:
Private Sub KitchenMainCode_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
Call Populate([Form])
End Sub
Populate(frm As Form)
'do stuff
End Function
I have 8 dropdowns which means I have to copy paste 8 batches of the same code which isn't ideal, Ideally I would like something like this:
Private Sub KitchenMainCode_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
Call Populate([Form], [control.name OR "KitchenMainCode"])
End Sub
Populate(frm As Form AND dropdown name as name)
frm.name.value = xyz
End Function
Even at the least, if I can pass a string Its easier to make 8 Mousedown events than 8 unique functions, which is nearly 50 lines (x8).
Every time I google this, its bringing lots of Excel stuff & for some reason the code that's used isn't compatible with access (probably my issue) but they're both VBA scripts.
Kind regards,

You can do like this:
Private Sub KitchenMainCode_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
Call Populate(Me, Me.ActiveControl, Button, Shift, X, Y)
End Sub
Private Sub Populate(frm As Form, ctl As Control, Button As Integer, Shift As Integer, X As Single, Y As Single)
' do stuff
End Function
Or you could implement WithEvents. An example can be found in my project VBA.ModernTheme.
To call a function:
Private Sub KitchenMainCode_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
Dim Result As Long ' as the function returns.
Result = Populate(Me, Me.ActiveControl, Button, Shift, X, Y)
End Sub
Private Function Populate(frm As Form, ctl As Control, Button As Integer, Shift As Integer, X As Single, Y As Single) As Long
' do stuff
Populate = SomeResultValue
End Function

Related

VBA form - Returning a textbox object to be manipulated

I'm creating a game in a vba form. Right now it creates an array 9x9 of textboxes and fills and disables the textboxes with the given information for the game. When creating the textboxes I named them "fieldx-y" so I could look them up easily. I want to somehow put them into an array so that I can look them up like field(x,y) and then do things to them like change the background color of the textbox or change information in it.
Here is the function I wanted to use to find the object using its name and return it to be manipulated.
Public Function getField(x As Integer, y As Integer) As MSForms.TextBox
Dim field As MSForms.TextBox
For Each field In Me.Controls
If Right(field.Name, 1) = y And Left(Right(field.Name, 3), 1) = x Then
getField = field
End If
Next
End Function
And here is how I would like to manipulate it from my userform initialize sub
getField(5,5).Enabled=False
I'm sure I must be doing something very wrong and it's probably because of my lacking understanding of OOP and vba.
Thanks
Since you have chosen a predictable naming convention you can call these controls directly using your naming convention. There is no need to loop through all the controls. Also, I changed your fieldx-y to fieldx_y because - is an illegal character variable names.
Public Function getField(x As Integer, y As Integer) As MSForms.TextBox
set getField = me.controls("field" & x & "_" & y)
End Function
If all you are doing is enabling the control, then you may not actually need to return the textbox, in which case do not add the tb variable to the calling procedure, and change your function to a sub, like:
Public Sub getField(x As Integer, y As Integer)
Dim field As MSForms.TextBox
For Each field In Me.Controls
If Right(field.Name, 1) = y And Left(Right(field.Name, 3), 1) = x Then
'## Disable this textbox
field.Enabled = False
Exit For
End If
Next
End Sub
If you do need to return a textbox to the calling procedure, then do this:
In your calling procedure, you need an object variable to represent the returned MSForms.TextBox:
Dim tb as MSForms.TextBox
Set tb = getField(5,5)
tb.Enabled = False
Then in your function routine, because it is an object, you need the Set keyword:
Set getField = field
Exit For '## You need to escape the loop otherwise it will keep going, giving undesired results.

Free Basic Calculator Issue

I have attempted to create a calculator with FreeBasic. What is the problem with line 9 in my code? Line 6 says that the dim choice is default and not allowed while line 9 tells me the variable isn't declared.
1 declare sub main
2 declare sub add
3 declare sub subtract
4 main
5 sub main
6 dim choice
7 print "1.Add"
8 print "2.subtract"
9 input "what is your choice" ; choice
Your source code is quite incomplete. For example, it misses the data types. In FreeBASIC you choose between several data types depending on what kind of data you want to store (Integer, Double, String, ...).
Moreover, you did not define how your sub programs actually should work. You didn't give any code what your procedure "subtract" should do.
Here's a working example of your small calculator:
' These two functions take 2 Integers (..., -1, 0, 1, 2, ...) and
' return 1 Integer as their result.
' Here we find the procedure declarations ("what inputs and outputs
' exist?"). The implementation ("how do these procedures actually
' work?") follows at the end of the program.
Declare Function Add (a As Integer, b As Integer) As Integer
Declare Function Subtract (a As Integer, b As Integer) As Integer
' == Begin of main program ==
Dim choice As Integer
Print "1. Add"
Print "2. Subtract"
Input "what is your choice? ", choice
' You could use "input" (see choice above) to get values from the user.
Dim As Integer x, y
x = 10
y = 6
If (choice = 1) Then
Print Add(x, y)
ElseIf (choice = 2) Then
Print Subtract(x, y)
Else
Print "Invalid input!"
End If
Print "Press any key to quit."
GetKey
End
' == End of main program ==
' == Sub programs (procedures = subs and functions) from here on ==
Function Add (a As Integer, b As Integer) As Integer
Return a + b
End Function
Function Subtract (a As Integer, b As Integer) As Integer
Return a - b
End Function

Wanting to allow only 2 of the same form to be opened VB6

So far i have some code that allows a user to Hit F1 which loads a new form of the same properties and then hides the one the first one they had up, Hitting F2, allows the user to close the newly opened form and show the one they opened first. I would like a restriction that allows the user to open only 1 extra form if they hit F1 with 2 of the same forms open then a messagebox appears telling them to close the second form first otherwise allow it to be opened.
Here is what i have so far.
Private Sub Form_Load()
End Sub
Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
Select Case KeyCode
Case vbKeyF1
'hides the current form
Me.Hide
'loads a new form with the same properties
Dim f As New Form1
Load f
'shows this new form
f.Show
'says that the second form is open
fOpen = True
Case vbKeyF2
'closes the second form
Unload Me
'says that the second form is closed
fOpen = False
'shows the first form you were on
Form1.Show
End Select
End Sub
Private Sub Form_QueryUnload(cancel As Integer, unloadmode As Integer)
'if your hitting "X" on second form then just close form2
If fOpen = False Then
Form1.Show
Else
'if your hitting "X" on main form close everything
Unload Me
End If
End Sub
Maybe something like if fOpen = true then disallow the user to hit F1? Not quite sure, but im close.
Forgive me if my VB6 is a little off, but you need to enumerate though the Forms collection to check to see if your form is already open...
Dim frm As Form
For Each frm In Forms
If frm.Name = "myForm" Then frm.Show()
Next frm
See this.
-- EDIT --
Just while I think on, to tune your code you could use a numeric iteration...
Dim f As Integer
Dim t As Integer
t = Forms.Count - 1
For f = 0 To t
If Forms(f).Name = "myForm" Then Forms(f).Show()
Next frm
-- EDIT 2 --
Just a further note on this. You may also want to introduce a counter so that you can check to see if there are two fields as in your original post...
Dim frm As Form
Dim c As Integer
For Each frm In Forms
If frm.Name = "myForm" Then
c = c + 1
If c = 2 Then
frm.Show()
Exit For 'Speed up the search if there are lots of forms
End If
End if
Next frm

Binding a 2D array of doubles to a parameter in MS Solver Foundation

How to bind a 2D array to a parameter in Solver Foundation? Have tried defining the array as double(,); as double()() and as a list of tuples(double, i, j).
I have also tried to implement the extension methods to SetBinding, suggested here; http://blogs.msdn.com/b/solverfoundation/archive/2010/06/28/simpler-data-binding-using-linq-and-extension-methods.aspx
Currently fails at third line to bottom; m_cov.SetBinding(CovMatrix), with error "This method is only valid when called on parameters with 0 indexes"
I'm using latest version and working in vb.net. Any help appreciated.
Thanks,
Yug
Public Sub ERC()
Dim m_i = New [Set](Domain.Any, "I")
Dim m_j = New [Set](Domain.Any, "J")
'Dim m_allocation As Decision
Dim CovMatrix As Double()() = {New Double() {0.1, 0.15, 0.4}, New Double() {0.3, 0.5, 0.8}, New Double() {0, 0.33, 0.05}}
Dim m_context As SolverContext = SolverContext.GetContext()
Dim m_model As Model = m_context.CreateModel()
m_model.Name = "ERC"
' Create a Parameter for Cov
Dim m_cov = New Parameter(Domain.Real, "Cov", m_i, m_j)
m_model.AddParameter(m_cov)
' Create a Decision for Allocation
Dim m_allocation As Decision = New Decision(Domain.RealRange(-1.0, 1.0), "Allocation", m_i)
m_model.AddDecision(m_allocation)
' Add Constraint for SumWts
m_model.AddConstraint("SumWts", (Model.Sum(Model.ForEach(m_i, Function(i_1) Model.Abs(Model.Sum(m_allocation(i_1)))))) = 1.0)
' Add Goal for Variance
m_model.AddGoal("Variance", GoalKind.Minimize, Model.Sum(Model.ForEach(m_i, Function(i_2) Model.ForEach(m_j, Function(j_3) Model.Power((Model.Abs(Model.Sum(Model.ForEach(m_j, Function(j_4) Model.Product(m_cov(i_2, j_4), m_allocation(j_4), m_allocation(i_2))))) - Model.Abs(Model.Sum(Model.ForEach(m_j, Function(j_6) Model.Product(m_cov(j_3, j_6), m_allocation(j_6), m_allocation(j_3)))))), 2.0)))))
m_cov.SetBinding(CovMatrix)
m_context.Solve()
Debug.Print(m_allocation.GetValuesByIndex().ToString)
End Sub
The helper class provided by Nathan Brixius makes SetBinding way easier. His helper class is in C#, so I went ahead and converted the particular helper function you will need into VB (see below).
The exception is telling you that the SetBinding function needs to know the indices for the data passed in. MSF is built to handle generic domains, meaning it does not abide by normal array indices. You have to explicitly point out the index information.
The problem with your code is that you are trying to pass in raw arrays without any extra index data. To remedy this on a normal 1D array, you would add indices using KeyValuePair(Of Integer, Double). In this case for a matrix you need a list of Tuple (index1, index2, Double). Essentially, you need to flatten the 3x3 matrix into 9 triples, specifying each value according to a pair of indices.
Here is the VB function to convert your matrix into a list as such:
Private Function ToIEnumerable(Of T)(matrix As IEnumerable(Of IEnumerable(Of T))) As IEnumerable(Of Tuple(Of Integer, Integer, T))
Dim m = matrix.[Select](Function(row, i) row.[Select](Function(cell, j) New Tuple(Of Integer, Integer, T)(i, j, cell)))
Dim cells = From cell In m.SelectMany(Function(c) c)
Return cells
End Function
Include this function in your class, and then change the SetBinding line of code like so:
m_cov.SetBinding(ToIEnumerable(CovMatrix), "Item3", "Item1", "Item2")
Notice the ordering of the Tuple items! By MSF convention, the value field comes before the indices. The same ordering is returned in the Solution output (important to note when you are looking to iterate over the Decisions on the result set).
If you convert the rest of Nathan's helper class, he makes it even easier by overloading the SetBinding function itself to abstract away the ToIEnumerable(data) call as well as the key/value identifier ordering. Then you are able to simply call model.SetBinding(rawMatrix).
Pretty slick, eh? ;)

Execute code when form is closed in VBA (Excel 2007)

I would like to execute some code when a user closes a form using the x button in the top right corner of the window (I have the form load when the excel spreadsheet is opened, and it hides Excel. I want to exit excel once the form is closed, or at least show excel again so the user may exit it manually)
Looking at the form properties, the Unload property is not present, nor am I able to figure out how to make a function which executes when the form is closed.
Unfortunately, coding this in VB is not an option, it must be VBA.
I'm aware of the code needed to unhide Excel or quit it outright, just not how to tie it to the unload event.
You can use QueryClose event of the UserForm as follows:
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
If CloseMode = 0 Then
' Your codes
' Tip: If you want to prevent closing UserForm by Close (×) button in the right-top corner of the UserForm, just uncomment the following line:
' Cancel = True
End If
End Sub
You can also use vbFormControlMenu like this:
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
If CloseMode = vbFormControlMenu Then
'Your code goes here
End If
End Sub
A colleague was able to provide the answer, including example here for everybody else
Private Sub userform_terminate()
'Code goes here
End Sub
You can use Unload Me in VBA to close a form. Just put the code to close Excel immediately following that.
Private Sub Form_Unload(Cancel As Integer)
Dim msgRes As VbMsgBoxResult
msgRes = MsgBox("Exit form ?", vbYesNo)
If msgRes = vbYes Then
'optional code
ElseIf msgRes = vbNo Then
Cancel = True
End If
End Sub
I was able to prevent the form from closing when the X button was click using the following:
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
Cancel = MsgBox("Please confirm cancellation", vbOKCancel + vbQuestion) = vbCancel
End Sub
try something like this:-
Private Sub Form1_FormClosing(sender as Object, e as FormClosingEventArgs) _
Handles Form1.FormClosing
//Code you want to execute
End Sub