VBA form - Returning a textbox object to be manipulated - forms

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.

Related

Applying one Event to multiple Elements [duplicate]

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

All tables in the bracketed expression must have the same variable names

I have two editable numeric fields and a table in app designer; the user can enter the values in these editable fields and then push a button. Then, the values are added to a table. Also, I provide an option to attach an excel folder that should have two columns to reflect on the table.
Both of these work perfectly fine individually, but, if I added the values manually then attached an excel folder or vice versa, I get the following error: All tables in the bracketed expression must have the same variable names.
The function that handles the editable fields:
app.t = app.UITable.Data;
x = app.xvalueEditField.Value;
y = app.yvalueEditField.Value;
nr = table(x, y);
app.UITable.Data = [app.t; nr]; %% error happens here if I attach excel then add manually
app.t = app.UITable.Data;
The Function of the excel folder:
text = readtable([pathname filename], "Sheet",1, 'ReadVariableNames',false);
fl = cellfun(#isnumeric,table2cell(text(1,:)));
if (numel(fl(fl == false)) > 0)
flag = false;
else
flag = true;
end
if (flag)
A = [app.t; text]; %% error happens here if I add manually then attach
app.UITable.Data = A;
app.t = text;
end
Note: these are only the parts of the function, where I attempt to combine values
Can someone please help me?
Thank you
The error message is telling you that table only allows you to vertically concatenate tables when the 'VariableNames' properties match. This is documented here: https://www.mathworks.com/help/matlab/ref/vertcat.html#btxzag0-1 .
In your first code example, the table nr will have variable names x and y (derived from the names of the underlying variables you used to construct the table). You could fix that case by doing:
% force nr to have the same VariableNames as app.t:
nr = table(x, y, 'VariableNames', app.t.Properties.VariableNames);
and in the second case, you can force text to have the correct variable names like this:
text.Properties.VariableNames = app.t.Properties.VariableNames

Numerical values associated with Drop Down options

So I am creating an app to work out a value based on a series of variables. The variables are:
Gender
Age
Weight
Creatinine
Here's what the app looks like:
In order to simplify the process somewhat I decided to make the gender selection a dropdown menu, this has caused me some issues since I have it setup like so:
And the maths associated with the button looks like so:
function CalculateButtonPushed(app, event)
gender = app.PatientGenderDropDown.Value ;
age = app.PatientAgeEditField.Value ;
weight = app.LeanBodyWeightEditField.Value ;
serum = app.SerumCreatinineEditField.Value ;
final = (gender*(age)*weight) / (serum) ;
app.ResultEditField.Value = final ;
end
end
Running this gives the following error:
Error using
matlab.ui.control.internal.model.AbstractNumericComponent/set.Value
(line 104) 'Value' must be numeric, such as 10.
As far as I am aware, the values I input into ItemsData are numeric values. Have I missed something or is there a better way to do this?
If you put a breakpoint in the offending file on the appropriate line (by running the below code),
dbstop in uicomponents\+matlab\+ui\+control\+internal\+model\AbstractNumericComponent.m at 87
you could see the following in your workspace, after clicking the button:
There are two separate problems here, both of which can be identified by looking at the newValue validation code (appearing in AbstractNumericComponent.m):
% newValue should be a numeric value.
% NaN, Inf, empty are not accepted
validateattributes(...
newValue, ...
{'numeric'}, ...
{'scalar', 'real', 'nonempty'} ...
);
Here are the issues:
The new value is a vector of NaN.
The reason for this is in this line:
final = (gender*(age)*weight) / (serum) ;
where serum has a value of 0 - so this is the first thing you should take care of.
The new value is a vector of NaN.
This is a separate problem, since the set.Value function (which is implicitly called when you assign something into the Value field), is expecting a scalar. This happens because gender is a 1x4 char array - so it's treated as 4 separate numbers (i.e. the assumption about ItemsData being a numeric is incorrect). The simplest solution in this case would be to str2double it before use. Alternatively, store the data in another location
(such as a private attribute of the figure), making sure it's numeric.

how to pass cellrange to a user defined macro paramenter

i would like to work with cellranges within my macro.
Function SumIfColor(SumRange)
Dim oRange as object
Dim oSheet as object
' Get Access to the Active Spreadsheet
oSheet = ThisComponent.CurrentController.ActiveSheet
' Get access to the Range listed in Sum Range
oRange = oSheet.getCellRangeByName(SumRange).RangeAddress
End Function
The question is how can I call this function with real cellRange object instead of String. Because getCellRangeByName works only with String variable.
Because when I call the function like this
sumifcolor(B1:B3)
I got the following error:
"Object variable not set"
I read some hint here but it did not helped me.
It is not possible to pass an actual CellRange object. One solution is to pass the row and column number, similar to the second part of #Axel Richter's answer in the link:
Function SumIfColor(lcol1, lrow1, lcol2, lrow2)
sum = 0
oCellRange = ThisComponent.CurrentController.ActiveSheet.getCellRangeByPosition(_
lcol1-1,lrow1-1,lcol2-1,lrow2-1)
For lCol = 0 To oCellRange.Columns.Count -1
For lRow = 0 To oCellRange.Rows.Count -1
oCell = oCellRange.getCellByPosition(lCol, lRow)
If oCell.CellBackColor > -1 Then
sum = sum + oCell.Value
End If
Next
Next
SumIfColor = sum
End Function
To call it:
=SUMIFCOLOR(COLUMN(B1:B3),ROW(B1),COLUMN(B3),ROW(B3))
The sum will be recalculated whenever a value in the range B1:B3 is changed, because of COLUMN(B1:B3). However, apparently changing only the color of a cell does not cause it to be recalculated.

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? ;)