VB.NET LISTBOX [in and out] - vb.net

I was actually working an Attendance System, using listbox i want to monitor whether "employees" timed in or out.
txtEmpNum.text as my textbox,
rdTin as my radio button for time in,
rdTout as my radio button for time out,
lblName, lblDept, lblinout are just label. I want that if a user already timed in his/her name wont appear on my listbox rather msgbox pop up. But on this code although msgbox poped up, still the name of the employee appears on my listbox.
If txtEmpNum.Text = 8888 Then
If rdTin.Checked = True Then
For i As Integer = 0 To listEmp.Items.Count - 1
If (listEmp.Items(i).ToString.Contains("Bane Lim")) Then
MsgBox("String found at " & (i + 1).ToString)
Exit For
End If
Next
lblName.Text = "Bane"
lblDept.Text = "Admin"
lblinout.Text = "In"
listEmp.Items.Add("Bane Lim")
txtEmpNum.Clear()
ElseIf rdTout.Checked = True Then
lblName.Text = "Bane"
lblDept.Text = "Admin"
lblinout.Text = "Out"
listEmp.Items.Remove("Bane Lim")
txtEmpNum.Clear()
End If

Is the problem that the name is appearing a second time? You'll want to Exit Sub or Exit Function rather than Exit For. Exit For is kicking it from the loop but continuing with the remaining code (to add again).
Otherwise add a flag in there like:
If txtEmpNum.Text = 8888 Then
If rdTin.Checked = True Then
Dim bolFound As Boolean = False
For i As Integer = 0 To listEmp.Items.Count - 1
If (listEmp.Items(i).ToString.Contains("Bane Lim")) Then
MsgBox("String found at " & (i + 1).ToString)
bolFound = True
Exit For
End If
Next
If Not bolFound Then
lblName.Text = "Bane"
lblDept.Text = "Admin"
lblinout.Text = "In"
listEmp.Items.Add("Bane Lim")
txtEmpNum.Clear()
End If
ElseIf rdTout.Checked = True Then
lblName.Text = "Bane"
lblDept.Text = "Admin"
lblinout.Text = "Out"
listEmp.Items.Remove("Bane Lim")
txtEmpNum.Clear()
End If

Related

How to Pause my code while user click button in another form in VB.NET

This is the code as you notice. I want stop the code if EndBill_Form Show. If user click save button the code will continue. I tried frm.ShowDialog() and worked fine but there is two buttons in another form Save and cancel. If I press cancel button also execute the code
If ItemsNoLbl.Text = "0" Then
MsgBox("There is no item to sale")
Exit Sub
Else
Dim frm As New EndBill_FRM
frm.CustomerLbl.Text = "Customer Name : " + CustomerCmb.Text
If CustomerCmb.Enabled = False Then
frm.BalanceLbl.Text = "Balance: 0&"
frm.LastDebtLbl.Text = "0"
frm.BalLbl.Text = "0"
Else
frm.BalanceLbl.Text = "Balance:" + BalanceLbl2.Text
frm.LastDebtLbl.Text = DebtLbl2.Text
frm.BalLbl.Text = BalanceLbl.Text
End If
frm.totalLbl2.Text = TotalLbl2.Text
frm.totalLbl.Text = TotalLbl.Text
frm.debt = Val(DebtLbl2.Text)
frm.totalBill = Val(TotalLbl2.Text)
frm.balance = Val(BalanceLbl.Text)
frm.Show()
' ****** Here should stop *****
' ****** Here should continue *****
If CustomerCmb.Enabled = False Then
InsertSalse()
Else
Dim debt As Decimal = Val(DebtLbl2.Text)
Dim totalBill As Decimal = Val(TotalLbl2.Text)
Dim total As Decimal = debt + totalBill
If total < Val(BalanceLbl.Text) Then
InsertSalse()
Else
MsgBox("The sale could not be completed because the invoice amount exceeded the available balance")
Exit Sub
End If
End If
MsgBox("Saved Seccessfully!")
UpdateQuantity()
New Sale_Form.Show()
End If
Please help me
' ****** Here should stop *****
frm.ShowDialog()
'Tag the form (more options than DialogResult) and hide the form
Dim frmTag As String = frm.Tag
frm.Close()
If frmTag = "Stop" Then
'Your logic decision goes here
End If
' ****** Here should continue *****

MS Access Form VBA Check Checkboxes, Before Checking Others?

I am working on an Access application, with a SQL back-end.
I have a form for people, where each person can need to have different things checked or unchecked. There are the following fields and corresponding controls on the form:
No Options (integer - boolean - checkbox)
Option A (integer - boolean - checkbox)
Option A Amount (money)
Option B (integer - boolean - checkbox)
Option B Amount (money)
Option C (integer - boolean - checkbox)
Option C Amount (money)
Option D (integer - boolean - checkbox)
Option D command button (opens popup form with option type drop down and amounts for multiple values to be entered).
My concern is that if someone checks one box, it can conflict with another checkbox or money fields.
If someone checks No Options, and one of the other options is checked, I have to uncheck those. I also need to 0 out their corresponding money field. If there are Option D "Other Option" records, in a linked table, then I need to delete those too, after I confirm with the user. I also want to disable the checkboxes and money/ command button controls for options A - D.
If I am unchecking No Options, then I need to enable all of that.
You can start to see how every time I check any of the No Options, or Options A - D, I have to check the state of No Options, and the option's corresponding money amount, to confirm the user wants to make this change.
To do that, I set up the following code for the No Options Before update:
Private Sub NoOptions_BeforeUpdate(Cancel As Integer)
Dim Msg, Style, Title
Dim delOLiensSQL
If Me.NoOptions = False Then
If (Me.OptionA = True Or Me.OptionB = True Or Me.OptionC = True Or Me.OptionD = True) Then
Msg = "You have chosen No Options, but one or more option is checked." & vbCrLf & _
"Choosing No Options will require removing all Lien amounts." & vbCrLf & _
"Would you like to change this Person to No Options?"
Style = vbYesNo
Title = "All Options Will Be Reset to 0 and False."
Response = MsgBox(Msg, Style, Title)
If Response = vbYes Then
If Nz(DLookup("ID", "tblPersonOtherOptionsD", "FKPerson = " & Me.ID), 0) Then
delOLiensSQL = "Delete From tblPersonOtherOptionsD Where FKPerson = " & Me.ID
DoCmd.RunSQL delOoptionssSQL, dbSeeChanges
End If
Me.OptionA = False
Me.OptionAAmount = 0
Me.OptionB = False
Me.OptionBAmount = 0
Me.OptionC = False
Me.OptionCAmount = 0
Me.OptionD = False
OptionsAllowPubFunc (False)
Else
Me.Undo
MsgBox "OK, we will leave everything as it is.", vbOKOnly, "Better Safe Than Sorry"
End If
Else
Me.NoOptions = True
End If
Else
Me.NoOptions = False
End If
End Sub
OptionsAllowPubFunc (False) is a public function which is the following:
Public Function PlaintiffLiensAllowed(Liens As Boolean)
Forms!frmPerson.OptionAAmount.Enabled = Liens
Forms!frmPerson.OptionBAmount.Enabled = Liens
Forms!frmPerson.OptionCAmount.Enabled = Liens
Forms!frmPerson.OptionDAmount.Enabled = Liens
End Function
I also set up Before Update public function for OptionA, OptionB, OptionC, OptionD as follows:
Public Function ChangeAOption(OptionCheck As Control, OptionAmount As Control, OptionName As String)
Dim Msg, Style, Title
Dim Msg2, Style2, Title2
If OptionCheck = True Then
If Nz(OptionAmount, 0) > 0 Then
Msg = "There is a " & OptionName & " Option amount. Unchecking " & OptionName & " Option, will require the amount to be 0." & vbCrLf & _
"Would you like to uncheck " & OptionName & " Option and make the amount 0?"
Style = vbYesNo
Title = "Confirm No " & OptionName & " Option."
Response = MsgBox(Msg, Style, Title)
If Response = vbYes Then
OptionAmount = 0
OptionCheck = False
Else
OptionCheck.Undo
MsgBox "Ok, we will leave it as is.", vbOKOnly, "Better Safe Than Sorry."
End If
Else
OptionCheck = False
End If
Else
If Forms!frmPerson.NoOptions = True Then
Msg2 = "No Options is Checked. Checking " & OptionName & " Options will require no Options to be unchecked." & vbCrLf & _
"Would you like to uncheck no Options?"
Style2 = vbYesNo
Title2 = "Confirm No Options False."
Response2 = MsgBox(Msg2, Style2, Title2)
If Response2 = vbYes Then
OptionsAllowPubFunc (True)
Forms!frmPerson.NoOptions = False
OptionCheck = True
Else
OptionCheck = True
End If
Else
OptionCheck = True
End If
End Function
I'm testing this, and when I try to check the No Options checkbox, changing it from false to true, I get a run-time error '-2147352567 (80020009)':
The macro or function set to BeforeUpdate or ValidationRule property
for this field is preventing the [People application] from saving data
in the field.
Anyone know what I'm doing wrong? Is there a more simple way to do this?
Thank you!!!
From my recent experience, when the Before Update event is triggered it uses the new value of the field in any calculations. So I'd expect you to want to start that main If statement like If Me.NoOptions = True Then.
I also don't believe you need the Else OptionCheck = True bits just before the End Ifs.
What may be causing a problem is you've called OptionsAllowPubFunc, but the function you've included in this question is actually called PlaintiffLiensAllowed - unless you have an identical function called OptionsAllowPubFunc, this'll give you an error.
Finally, I've never found me.undo to be especially helpful in this kind of context, but the Before Update gives you an out - just tell it to cancel using Cancel = True (or anything that isn't 0) and it'll not update the field and exit the sub.
You could also add in a bit to re-enable the option fields if they were un-checking the box.
Try running it as:
Private Sub NoOptions_BeforeUpdate(Cancel As Integer)
Dim Msg As String, Style As VbMsgBoxStyle, Title As String
Dim Response As VbMsgBoxResult, delOLiensSQL As String
If Me.NoOptions = True Then
If (Me.OptionA = True Or Me.OptionB = True Or Me.OptionC = True Or Me.OptionD = True) Then
Msg = "You have chosen No Options, but one or more option is checked." & vbCrLf & _
"Choosing No Options will require removing all Lien amounts." & vbCrLf & _
"Would you like to change this Person to No Options?"
Style = vbYesNo
Title = "All Options Will Be Reset to 0 and False."
Response = MsgBox(Msg, Style, Title)
If Response = vbYes Then
If Nz(DLookup("ID", "tblPersonOtherOptionsD", "FKPerson = " & Me.ID), 0) Then
delOLiensSQL = "Delete From tblPersonOtherOptionsD Where FKPerson = " & Me.ID
DoCmd.RunSQL delOoptionssSQL, dbSeeChanges
End If
Me.OptionA = False
Me.OptionAAmount = 0
Me.OptionB = False
Me.OptionBAmount = 0
Me.OptionC = False
Me.OptionCAmount = 0
Me.OptionD = False
PlaintiffLiensAllowed(False)
Else
MsgBox "OK, we will leave everything as it is.", vbOKOnly, "Better Safe Than Sorry"
Cancel = True
End If
End If
Else
PlaintiffLiensAllowed(True)
End If
End Sub

VBA Input Box will not close

I currently have a code shown below for entering a password to have the code start. I am a VBA noob so please go easy on me.
Issue: When the input box prompt appears it works fine if the password is correct. If it is incorrect you are given more opportunities to enter it again but lets say you do not know the password and want to close the window, you cannot. The "x" option and cancel options will just cause the input box prompt to refresh rather than closing the window. How can I set the window up to close?
Here is the code in written form:
Sub Pword()
Dim Ans As Boolean
Const Pword As String = "black2"
Ans = False
Do While Ans = False
If InputBox("Please enter password to continue.", "Enter Password") = Pword Then
Ans = True
End If
Loop
Sheets("Workshop").Range("B15:B20") = ""
Sheets("Workshop").Range("B24:B29") = ""
Sheets("Workshop").Range("B33:B35") = ""
Sheets("Workshop").Range("E5:E11") = ""
Sheets("Workshop").Range("E15:E26") = ""
Sheets("Workshop").Range("H5:H17") = ""
MsgBox "All data has been cleared."
End Sub
If you need to consider an empty string as a valid input value, the only way to check if the InputBox was actually cancelled isn't to compare its result with vbNullString or "" (both will be True).
So you can use the (undocumented) StrPtr function to determine if the InputBox call returned a legit empty string, or if it was actively cancelled with the [X] or [Cancel] button:
Dim result As String
result = InputBox(...)
If StrPtr(result) = 0 Then
' inputbox was cancelled
Exit Sub
Else
' todo: validate result
End If
Combine that with the other answers to get a reliable "retry" mechanism.
Add a check to see if it's an empty string, like this:
Dim sResult As String
Do While Ans = False
sResult = InputBox("Please enter password to continue.", "Enter Password")
If sResult = Pword Then
Ans = True
ElseIf sResult = "" Then
Exit Do ' or Exit Sub depending on what you want to happen afterwards
End If
Loop
#braX suggestion is an excellent solution.
Also, you can limit the attemps to n in this case I limit the attempts to 3
Dim sResult As String
Dim Attmp As Integer
Attmp = 0
Do While Ans = False
sResult = InputBox("Please enter password to continue.", "Enter Password")
If sResult = Pword Then
Ans = True
ElseIf sResult = "" Then
Attmp = Attmp + 1
If Attmp = 3 Then
Msgbox "Maximum attempts reached."
Exit Do
End If
End If
Loop

Background worker Picturebox gif

I have a picturebox with a gif (the gif works). My program is written to open up a document file that is located on a drive on the other side of the country, so it takes some time.
I have set picturebox.visible = true when the program starts the connection process, but the gif does not animate during this process; but only when idling.
A Google search led me to the background worker control, but in all the examples I found, I could not find one that could either:
Just have the gif running in a background worker permanently (I assume this wouldn't use up too much memory, as it is just a gif)
or
Have the gif animate while the application is connecting
Can anyone help?
From the comments, I'm assuming that this entire thing needs to be in a backgroundworker.dowork, but I just keep getting errors because I'm changing controls here.
Private Sub btnLoad_Click(sender As Object, e As EventArgs) Handles btnLoad.Click
'Displaying "Loading"
picLoading.Visible = True
tblMain.Visible = False
'If the application has loaded at least one sheet
If FirstLoad = 2 Then
worksheet.Cells(1, 31).Value = ""
workbook.Save()
workbook.Close(False)
End If
Filter = cmbFilter.Text
'Go to page 1
CurrentPage = 0
workbook = APP.Workbooks.Open(Path & "\" & Filter & ".xlsx")
worksheet = workbook.Worksheets("Sheet1")
If Convert.ToString(worksheet.Cells(1, 31).Value) <> "" Then
MsgBox("The sheet for " & Filter & " is currently being used by " & Convert.ToString(worksheet.Cells(1, 31).Value) & ".")
workbook.Close(False)
Else
FirstLoad = 2 'Indicate that the application has loaded at least one sheet
worksheet.Cells(1, 31).Value = User
'Make all textboxes and comboboxes visible = false
txtSearch.Visible = False : btnSort.Visible = False : btnSortUrgency.Visible = False : btnSave.Visible = False : btnPrevious.Visible = False : btnNext.Visible = False
Label1.Visible = False
Label2.Visible = False
'Count entries and calculate how many pages there are
Entries = worksheet.Range("B1048576").End(Excel.XlDirection.xlUp).Row 'Count how many entries there are (the first row always counts as an entry)
TotalPages = Math.Ceiling(Entries / 8) - 1 'Calculate how many pages there are
If TotalPages = (Entries / 8) - 1 Then
TotalPages = TotalPages + 1
End If
'Determine how many entries are on the last page
LastEntries = Entries
While LastEntries > 8 'Keep subtracting by 8 to determine how many entries are going to be on the last page
LastEntries = LastEntries - 8
End While
'Add categories for the Urgency comboboxes
Me.cmbUrgency1.DrawMode = DrawMode.OwnerDrawFixed
Me. cmbUrgency1.DropDownStyle = ComboBoxStyle.DropDownList
Me. cmbUrgency1.ItemHeight = 15
Me. cmbUrgency1.BeginUpdate()
cmbUrgency1.Items.Clear()
Me. cmbUrgency1.Items.Add("1")
Me. cmbUrgency1.Items.Add("2")
Me. cmbUrgency1.Items.Add("3")
Me. cmbUrgency1.Items.Add("4")
cmbUrgency1.EndUpdate()
Me. cmbUrgency2.DrawMode = DrawMode.OwnerDrawFixed
Me. cmbUrgency2.DropDownStyle = ComboBoxStyle.DropDownList
Me. cmbUrgency2.ItemHeight = 15
Me. cmbUrgency2.BeginUpdate()
cmbUrgency2.Items.Clear()
Me. cmbUrgency2.Items.Add("1")
Me. cmbUrgency2.Items.Add("2")
Me. cmbUrgency2.Items.Add("3")
Me. cmbUrgency2.Items.Add("4")
cmbUrgency2.EndUpdate()
Me. cmbUrgency3.DrawMode = DrawMode.OwnerDrawFixed
Me. cmbUrgency3.DropDownStyle = ComboBoxStyle.DropDownList
Me. cmbUrgency3.ItemHeight = 15
Me. cmbUrgency3.BeginUpdate()
cmbUrgency3.Items.Clear()
Me. cmbUrgency3.Items.Add("1")
Me. cmbUrgency3.Items.Add("2")
Me. cmbUrgency3.Items.Add("3")
Me. cmbUrgency3.Items.Add("4")
Urgency3.EndUpdate()
Me.Urgency4.DrawMode = DrawMode.OwnerDrawFixed
Me.Urgency4.DropDownStyle = ComboBoxStyle.DropDownList
Me.Urgency4.ItemHeight = 15
Me.Urgency4.BeginUpdate()
Urgency4.Items.Clear()
Me.Urgency4.Items.Add("1")
Me.Urgency4.Items.Add("2")
Me.Urgency4.Items.Add("3")
Me.Urgency4.Items.Add("4")
Urgency4.EndUpdate()
Dim DataCollection As New AutoCompleteStringCollection()
txtBlank.AutoCompleteMode = AutoCompleteMode.Suggest
txtBlank.AutoCompleteSource = AutoCompleteSource.CustomSource
AddItems(DataCollection)
txtBlank.AutoCompleteCustomSource = DataCollection
txtBlank2.AutoCompleteMode = AutoCompleteMode.Suggest
txtBlank2.AutoCompleteSource = AutoCompleteSource.CustomSource
AddItems(DataCollection)
txtBlank2.AutoCompleteCustomSource = DataCollection
txtBlank3.AutoCompleteMode = AutoCompleteMode.Suggest
txtBlank3.AutoCompleteSource = AutoCompleteSource.CustomSource
AddItems(DataCollection)
txtBlank3.AutoCompleteCustomSource = DataCollection
txtBlank3.AutoCompleteMode = AutoCompleteMode.Suggest
txtBlank3.AutoCompleteSource = AutoCompleteSource.CustomSource
AddItems(DataCollection)
txtBlank3.AutoCompleteCustomSource = DataCollection
workbook.Save()
Call DisplayInfo()
End If
End Sub

How to concat variable integer in control name in vb.net

Now I have a database and pull out that data and display it to form,i have a sequence of groupbox and radiobuttons, in each groupbox (groupbox1,groupbox2,etc...) there are 2 radio buttons namely rdbtn1Yes and rdbtn1No (then it increment +1 in next Groupbox). now i use for loop to go through every groupboxes and radio buttons. And this is my code:
Dim sqlda As New SqlDataAdapter("SELECT * FROM table1 WHERE column1= '" & lblWONo.Text & "'", Constr)
Dim sqlds As New DataSet
sqlds.Clear()
sqlda.Fill(sqlds)
If sqlds.Tables(0).Rows.Count > 0 Then
With sqlds.Tables(0).DefaultView.Item(0)
txtDateCreated.Value = .Item(0).ToString
txtComments.Text = .Item(1).ToString
'check column if it contain FALSE/TRUE value
'then toggle the radiobutton state to TRUE
'In this part i know there is another/easiest way to checked radio buttons to TRUE value
'and this is my code using looping (below):
If .Item(2) = False Then
rdbtn1No.Checked = True
Else
rdbtn1Yes.Checked = True
End If
If .Item(3) = False Then
rdbtn2No.Checked = True
Else
rdbtn2Yes.Checked = True
End If
If .Item(4) = False Then
opt3N.Checked = True
Else
opt3Y.Checked = True
End If
End With
End If
SAMPLE CODE FOR LOOPING:
Dim itemNo As Integer
Dim rdbtnSet As Integer = 1
Dim grpboxCnt As Integer = 1
For Each grpbx As GroupBox In Me.Controls.OfType(Of GroupBox)()
For itemNo = 2 To sqlds.Tables(0).Columns.Count
If .Item(itemNo) = True Then
rdbtn & rdbtnSet & "Yes".checked = True 'I want to be this way but we know that this is not working or its not the proper way. That is my problem.
Else
rdbtn & rdbtnSet & "No".checked = True 'I want to be this way but we know that this is not working or its not the proper way. That is my problem.
End If
Next
rdbtnSet += 1
grpboxCnt += 1
Next
Thats all. Thank you in advance!
Think about the use of a dictionary (id, control) to store your controls. Then iterate the dictionary and set your state.