Restricting SpinButtons to specific Min and Max values VBA - vba

I am trying to restrict user to select value between a limit using SpinButton in VBA but its not working for me
Here is what I have tried
Private Sub UserForm_Initialize()
decimalSpin_Button.Min = 0
decimalSpin_Button.Max = 5
End Sub
Private Sub decimalSpin_Button_Change()
decimalPlaces_Value.Text = decimalSpin_Button.Value
End Sub
Private Sub decimalSpin_Button_SpinDown()
decimalPlaces_Value.Text = decimalPlaces_Value.Text - 1
End Sub
Private Sub decimalSpin_Button_SpinUp()
decimalPlaces_Value.Text = val(decimalPlaces_Value.Text) + 1
End Sub

You don't need the _SpinDown() and _SpinUp() This will do what you want
Private Sub UserForm_Initialize()
decimalSpin_Button.Min = 0
decimalSpin_Button.Max = 5
End Sub
Private Sub decimalSpin_Button_Change()
decimalPlaces_Value.Text = decimalSpin_Button.Value
End Sub

Related

Vb.net bindingsource.filter from a list of strings

i have in a windows.form a combobox and a datagridview,
i add rows in datagridview with a button and get the value(string) from combobox and if i double click on the row of datagridview i delete the row.
When i add the row i want to hide/disable/remove the combobox value and when i delete the row i want to restore it in combobox.
The combobox values are binding from dataset source and combobox is dropdownlist style.
I try some things until now but this is what i think is better approach and where i am:
Dim filterList As List(Of String) = New List(Of String)
Private Sub filterListAdd()
Dim dgResult As String
filterList .Clear() 'Clear the list so no duplicates
For i As Integer = 0 To combobox.Items.Count - 1
Dim a As String = combobox.GetItemText(combobox.Items(i))
For row As Integer = 0 To Dgview.RowCount - 1
For col As Integer = 0 To Dgview.ColumnCount - 1
Next
Surname = Dgview.Rows(row).Cells(0).Value.ToString
If dgResult = a Then
filterList .Add(a) 'Add to list
End If
Next
Next i
End Sub
Private Sub Button_Click(sender As Object, e As EventArgs) Handles Button.Click
Dgview.Rows.Add(combobox.Text)
filterListAdd()
'Here i want to bindingsource.filter = filterList
End Sub
Private Sub Dgview_MouseDoubleClick(sender As Object, e As MouseEventArgs) Handles Dgview.MouseDoubleClick
Dgview.Rows.Remove(Dgview.CurrentRow)
'I Guess here with the same way i filter it again
End Sub
Any help will be appreciated, thanks in advance.
Panos
Public Class Form1
Dim clsItems As New ArrayList()
Private Sub RemoveComboItem()
Me.BindingSource.Position = Me.BindingSource.Find("1", Combobox.Text)
Dim 1Add As String = DirectCast(BindingSource.Current, DataRowView).Item("1").ToString
Dim 2Add As String = DirectCast(BindingSource.Current, DataRowView).Item("2").ToString
Dim 3Add As String = DirectCast(BindingSource.Current, DataRowView).Item("3").ToString
clsItems.Add(New MyItem(1Add, 2Add, 3Add))
BindingSource.RemoveCurrent()
End Sub
Private Sub AddComboItem(dg As DataGridView) ' Because i have two datagridviews
Dim 1 As String = dg.CurrentRow.Cells(0).Value.ToString()
For i = 0 To clsItems.Count - 1
If i <= clsItems.Count - 1 Then
If 1 = clsItems(i).1 Then
Dim drNewRow As DataRow
drNewRow = DeeDataSet.Tables("Table").NewRow()
drNewRow("1") = clsItems(i).1
drNewRow("2") = clsItems(i).2
drNewRow("3") = clsItems(i).3
DeeDataSet.Tables("Table").Rows.Add(drNewRow)
clsItems.Remove(clsItems(i)) ' Remove it from array so no duplicates
End If
End If
Next
End Sub
Private Sub Button_Click(sender As Object, e As EventArgs) Handles Button.Click
RemoveComboItem()
End Sub
Private Sub Dgview_MouseDoubleClick(sender As Object, e As MouseEventArgs) Handles Dgview.MouseDoubleClick
AddComboItem(Dgview)
Dgview.Rows.Remove(Dgview.CurrentRow)
End Sub
End class
Public Class MyItem
Private m_s1 As String
Private m_s2 As String
Private m_s3 As String
Public Sub New(1As String, 2 As String, 3 As String)
M_sName = 1
M_sSurname = 2
M_sTitle = 3
End Sub
Public ReadOnly Property 1
Get
Return m_s1
End Get
End Property
Public ReadOnly Property 2
Get
Return M_s2
End Get
End Property
Public ReadOnly Property 3
Get
Return M_s3
End Get
End Property
End Class
In that form i don't update the dataset because every change i want to make it in other form, so when i finish from here the dataset.table has no changes.

Change foreground color of TreeView node from a seperated Thread

With the following code I fill a Treeview with a root node and several child nodes in the MainForm LoadEvent. With the button btnPing I go through the nodes and search for child nodes with level 2. These nodes are then queried with My.computer.network.ping and the ForeColor of the ChildNode is colored according to the result red or green. The whole works synonymous. However, the GUI freezes me every time.
'### TreeView Test
Option Explicit On
Option Strict On
Public Partial Class MainForm
Public Sub New()
Me.InitializeComponent()
End Sub
'### Hauptprogramm wird geladen ###
Sub MainFormLoad(sender As Object, e As EventArgs)
'Treeview befüllen
With treeView1
.Nodes.Add("Test1")
.Nodes(0).Nodes.Add("Test1_a")
.Nodes(0).Nodes.Add("Test1_b")
.Nodes(0).Nodes.Add("Test1_c")
.Nodes(0).Nodes(0).Nodes.Add("10.23.59.1")
.Nodes(0).Nodes(1).Nodes.Add("10.23.59.90")
.Nodes(0).Nodes(1).Nodes.Add("10.23.59.90")
.Nodes(0).Nodes(2).Nodes.Add("10.23.59.10")
.Nodes(0).Nodes(2).Nodes.Add("10.23.59.11")
.Nodes(0).Nodes(2).Nodes.Add("10.23.59.12")
.Nodes(0).Nodes(2).Nodes.Add("10.23.59.13")
.Nodes(0).Nodes(2).Nodes.Add("10.23.59.14")
End With
'Treeview aufklappen
treeView1.ExpandAll
End Sub
'### Sub zum rekursiven durchsuchen der Nodes ###
Private Sub RecurseNodes(ByVal col As TreeNodeCollection)
For Each tn As TreeNode In col
If tn.Level = 2 Then
Try
If My.Computer.Network.Ping(tn.Text) Then
tn.ForeColor = Color.Green
tn.StateImageIndex= 4
Else
tn.ForeColor = Color.Red
tn.StateImageIndex=5
End If
Catch ex As Exception
tn.ForeColor = Color.Red
tn.StateImageIndex=5
End Try
End If
If tn.Nodes.Count > 0 Then
RecurseNodes(tn.Nodes)
End If
Next tn
End Sub
'### Button zum starten der rekursiven Suche ###
Sub BtnPingClick(sender As Object, e As EventArgs)
'Treeview rekursiv durchsuchen
RecurseNodes(treeView1.Nodes)
End Sub
End Class
Now I would like to convert the whole so that the Ping runs in a separate thread. Now I have only one understanding question about the process. Can I start a thread with parameter transfer? Then I would run through the list and start with each node with level 2 a thread and wait for feedback. How would the best approach be?
Best Regards
Kay
Here's another approach:
Sub BtnPingClick(sender As Object, e As EventArgs)
'Treeview rekursiv durchsuchen
RecurseNodes(TreeView1.Nodes)
End Sub
Private Async Sub RecurseNodes(ByVal col As TreeNodeCollection)
For Each tn As TreeNode In col
If tn.Level = 2 Then
Dim T As Task(Of Boolean) = Ping(tn.Text)
Await T
tn.ForeColor = If(T.Result, Color.Green, Color.Red)
tn.StateImageIndex = If(T.Result, 4, 5)
ElseIf tn.Nodes.Count > 0 Then
RecurseNodes(tn.Nodes)
End If
Next tn
End Sub
Private Function Ping(ByVal ip As String) As Task(Of Boolean)
Return Task.Factory.StartNew(Of Boolean)(
Function() As Boolean
Try
Return My.Computer.Network.Ping(ip)
Catch ex As Exception
Return False
End Try
End Function)
End Function
Some ideas...
Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click
Dim t As Task = Task.Run(Sub()
RecurseNodes(TreeView1.Nodes(0))
End Sub)
End Sub
Private Sub RecurseNodes(ByVal col As TreeNode)
For Each tn As TreeNode In col.Nodes
If tn.Level < 2 AndAlso tn.Nodes.Count > 0 Then
RecurseNodes(tn)
ElseIf tn.Level = 2 Then
Dim tp As Task
tp = Task.Run(Sub()
Dim c As Color
Dim idx As Integer
Try
If My.Computer.Network.Ping(tn.Text) Then
c = Color.Green
idx = 4
Else
c = Color.Red
idx = 5
End If
Catch ex As Exception
c = Color.Red
idx = 5
End Try
Me.Invoke(Sub()
tn.ForeColor = c
tn.StateImageIndex = idx
End Sub)
End Sub)
End If
Next tn
End Sub

Date in Userform Text.Box not showing the data inserted

i have a simple userform with a textbox where the user inserts a date and another textbox where the user inserts a number. When i try to use the data from the form it will not show the inserted data: the date shows as 12:00:00 am and the numeber shows as 0 .
Here is the userform
Public Sub CancelButton_Click()
Unload Me
End
End Sub
Public Sub UserForm_Initialize()
TextBox1.Value = ""
TextBox2.Value = ""
End Sub
Public Sub btnOK_Click()
Dim xSO As Date
Dim ySO As String
xSO = Format(TimeValue(TextBox1.Value), "dd.mm.yyyy")
ySO = TextBox2.Value
Unload Me
End Sub
Here is the minimum sub:
Public xSO As Long, ySO As Long
Sub ffffff()
Dim x As Date, y As String
UserForm19.Show
x = xSO 'Format(TextBox1.Value, "dd.mm.yyyy")
y = ySO 'UserForm19.TextBox2.text
MsgBox x
MsgBox y
End Sub
You declared xSO and ySO twice.
Remove the local declaration from Public Sub btnOK_Click()
Dim xSO As Date
Dim ySO As String

How can i code this Vb.Net

I have a function that needs to execute every 30 mins. How can I filter it using Today.Minute?
Here are the Codes I made.
Protected Sub mainLoop()
Dim Counting As Integer = 0
Try
While (Not stopping)
While Counting <> 2
If Today.Minute >= 0 Then
If Counting = 1 Then
ElseIf Counting = 0 Or Counting = 2 Then
PingServers()
Counting = Counting + 1
ElseIf Today.Minute >= 31 Then
If Counting = 1 Then
PingServers()
Counting = Counting + 1
ElseIf Counting = 0 Then
End If
End If
End While
If Counting = 2 Then
DoFunction()
End If
End While
Catch ex As Exception
End Try
End Sub
Please any one. Help :3
I guess something like this would do the trick:
Module StartupModule
Private _timer As Timers.Timer
Sub Main()
SetTimer(3000)
Console.ReadLine()
KillTimer()
End Sub
Private Sub SetTimer(interval As Double)
_timer = New Timers.Timer(interval)
AddHandler _timer.Elapsed, AddressOf OnTimedEvent
_timer.Start()
End Sub
Private Sub KillTimer()
_timer.Stop()
_timer.Dispose()
End Sub
Private Sub OnTimedEvent(source As Object, e As ElapsedEventArgs)
Console.WriteLine(DateTime.Now)
End Sub
End Module

how to assign value to NodeLabelEditEventArgs variable

i created this sub
Sub CreateNewNode(tree As TreeView, e As NodeLabelEditEventArgs)
Dim nodeTxt As String
nodeTxt = e.Label
If e.Node.Level = 0 Then
Dim obj_carsType As New Cls_carsType
Dim Entity As New tblcarsType
Entity.Type = nodeTxt
obj_carsType .Insert(Entity)
Dim q = (From i In obj_logsType.Fill Select i.ID).Last
e.CancelEdit = True
tree.Nodes.Remove(e.Node)
tree.Nodes.Add(nodeTxt & " : " & q.tostring)
end sub
Sub TreeView1_NodeMouseClick()
e.Node.ContextMenuStrip =ContextMenuStrip1
end sub
Private Sub NEWITEmToolStripMenuItem_Click()
end sub
in last sub need to call first sub. also in last sub if user click on NEWITEM i must call the first sub how can i do it?? please help me
I think you need something like this:
Private Sub NEWITEmToolStripMenuItem_Click(byval sender as object, byval e as eventargs)
CreateNewNode(ctype(sender, TreeView), ctype(e,NodeLabelEditEventArgs))
end sub