hi I would like to load and unload a user form by calling formtimer with a string as the form name
not sure how I would go about it ,i would love some input
Public Sub callme()
FormTimer ("UserForm1")
End Sub
public Sub FormTimer(Fname As String)
Fname.Show vbModeless
Application.OnTime Now + TimeValue("00:00:02"), "UnloadIt(Fname)"
End Sub
Public Sub UnloadIt(name As string)
Unload name
End Sub
Try the following code...
Public Sub callme()
FormTimer "UserForm1"
End Sub
Public Sub FormTimer(Fname As String)
VBA.UserForms.Add(Fname).Show vbModeless
Application.OnTime Now + TimeValue("00:00:02"), "'UnloadIt """ & Fname & """'"
End Sub
Public Sub UnloadIt(name As String)
Dim uf As Object
For Each uf In VBA.UserForms
If uf.name = name Then
Unload uf
Exit Sub
End If
Next uf
End Sub
Related
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
I have a logging function that get called from different threads. The logging function uses InvokeRequired to determine if the caller is in the same thread as the textbox was created in. If all the code is put into the same class it works fine. But when separated out InvokeRequired always returns false.
Imports System.Threading
Public Class Test_Main
Dim tt_object As Test_Thread = Test_Thread.Get_Test_Thread_Class()
Private Shared logger_lock As New Object
Delegate Sub WriteLogMessage_Callback(text As String)
Private Sub btn_start_Click(sender As Object, e As EventArgs) Handles btn_start.Click
WriteLogMessage("From - btn_start_Click")
tt_object.Start_Threads()
End Sub
Public Sub WriteLogMessage(ByVal message As String)
If (Me.InvokeRequired) Then
Dim d As New WriteLogMessage_Callback(AddressOf WriteLogMessage)
Me.Invoke(d, New Object() {[message]})
Else
SyncLock logger_lock
log_box.Text += System.DateTime.Now.ToString("yyyy/MM/dd HH:mm:ss.fff") & " " & message & vbCrLf
log_box.SelectionStart = log_box.Text.Length
log_box.ScrollToCaret()
End SyncLock
End If
Application.DoEvents()
End Sub
End Class
Public Class Test_Thread
Private Shared _thisInstance As Test_Thread = Nothing
Private t_1 As Thread
Private t_2 As Thread
Protected Sub New() 'Class constructor
t_1 = New Thread(AddressOf Thread_1)
t_2 = New Thread(AddressOf Thread_2)
End Sub
Public Shared Function Get_Test_Thread_Class() As Test_Thread
If _thisInstance Is Nothing Then 'Initialize object if it hasn't laready been done
_thisInstance = New Test_Thread()
End If
Return _thisInstance 'Return the object instance
End Function
Public Sub Start_Threads()
Dim counter As Integer = 0
Test_Main.WriteLogMessage("BEGIN - Start_Threads")
t_1.Start()
t_2.Start()
Do While counter < 50
Application.DoEvents()
Thread.Sleep(500)
counter += 1
Loop
t_1.Abort()
t_2.Abort()
Test_Main.WriteLogMessage("END - Start_Threads")
End Sub
Public Sub Thread_1()
Dim counter As Integer = 0
Test_Main.WriteLogMessage("BEGIN - Thread_1")
Do While True
Test_Main.WriteLogMessage("Thread_1: " & counter)
counter += 1
Thread.Sleep(1000)
Loop
End Sub
Public Sub Thread_2()
Dim counter As Integer = 0
Test_Main.WriteLogMessage("BEGIN - Thread_2")
Do While True
Test_Main.WriteLogMessage("Thread_2: " & counter)
counter += 1
Thread.Sleep(1500)
Loop
End Sub
End Class
I solve it with the following code! Thanks for all the help.
Imports System.Threading
Public Class Test_Main
Private Sub btn_start_Click(sender As Object, e As EventArgs) Handles btn_start.Click
Dim log_object As Logger = Logger.Get_Logger_Class(log_box)
Dim tt_object As Test_Thread = Test_Thread.Get_Test_Thread_Class(log_object)
log_object.WriteLogMessage("From - btn_start_Click")
tt_object.Start_Threads()
End Sub
End Class
Public Class Logger
Private Shared _thisInstance As Logger = Nothing
Private log_box As TextBox
Delegate Sub WriteLogMessage_Callback(text As String)
Private Shared logger_lock As New Object
Public Shared Function Get_Logger_Class(log_box_addr As TextBox) As Logger
If _thisInstance Is Nothing Then 'Initialize object if it hasn't laready been done
_thisInstance = New Logger()
_thisInstance.log_box = log_box_addr
End If
Return _thisInstance 'Return the object instance
End Function
Public Sub WriteLogMessage(ByVal message As String)
If (log_box.InvokeRequired) Then
Dim d As New WriteLogMessage_Callback(AddressOf WriteLogMessage)
log_box.Invoke(d, New Object() {[message]})
Else
SyncLock logger_lock
Me.log_box.Text += System.DateTime.Now.ToString("yyyy/MM/dd HH:mm:ss.fff") & " " & message & vbCrLf
Me.log_box.SelectionStart = log_box.Text.Length
Me.log_box.ScrollToCaret()
End SyncLock
End If
Application.DoEvents()
End Sub
End Class
Public Class Test_Thread
Private Shared _thisInstance As Test_Thread = Nothing
Private log_addr As Logger
Public t_1 As Thread
Public t_2 As Thread
Protected Sub New() 'Class constructor
t_1 = New Thread(AddressOf Thread_1)
t_2 = New Thread(AddressOf Thread_2)
End Sub
Public Shared Function Get_Test_Thread_Class(logger_addr As Logger) As Test_Thread
If _thisInstance Is Nothing Then 'Initialize object if it hasn't laready been done
_thisInstance = New Test_Thread()
_thisInstance.log_addr = logger_addr
End If
Return _thisInstance 'Return the object instance
End Function
Public Sub Start_Threads()
Dim counter As Integer = 0
log_addr.WriteLogMessage("BEGIN - Start_Threads")
t_1.Start()
t_2.Start()
Do While counter < 50
Application.DoEvents()
Thread.Sleep(500)
counter += 1
Loop
t_1.Abort()
t_2.Abort()
log_addr.WriteLogMessage("END - Start_Threads")
End Sub
Public Sub Thread_1()
Dim counter As Integer = 0
log_addr.WriteLogMessage("BEGIN - Thread_1")
Do While True
log_addr.WriteLogMessage("Thread_1: " & counter)
counter += 1
Thread.Sleep(1000)
Loop
End Sub
Public Sub Thread_2()
Dim counter As Integer = 0
log_addr.WriteLogMessage("BEGIN - Thread_2")
Do While True
log_addr.WriteLogMessage("Thread_2: " & counter)
counter += 1
Thread.Sleep(1500)
Loop
End Sub
End Class
I'm trying to write a wrapper class to do some automated testing on a website with the WebBrowser control. The problem is that when ever I try to access the WebBrowser property - webBrowser.DocumentText - the thread fails and the property is empty.
Imports AutoItX3Lib
Imports System.Threading.Tasks
Imports System.Random
Imports System.Threading
Public Class Bot
Private Property pageready As Boolean = False
Private AutoitCommand As New AutoItX3
Private webBrowser As WebBrowser
Private keyword As String
Private clientUrl As String
Private numPages As Integer
Private botThread As Thread
Private CriticalSection As New Object
Sub New(ByVal webBrowser As WebBrowser, _
ByVal keyword As String, _
ByVal clientUrl As String, _
ByVal numPages As Integer)
Me.webBrowser = webBrowser
Me.keyword = keyword
Me.clientUrl = clientUrl
Me.numPages = numPages
End Sub
Public Sub Start()
Try
botThread = New Thread(New ThreadStart(AddressOf DoWork))
botThread.Start()
botThread.SetApartmentState(ApartmentState.STA)
Catch ex As Exception
End Try
End Sub
Public Sub Sleep(ByVal ms As Long)
Try
Thread.Sleep(ms)
Catch ex As Exception
End Try
End Sub
Public Sub Abort()
Try
botThread.Abort()
Catch ex As Exception
'Do nothing
End Try
End Sub
Private Sub DoWork()
For i = 1 To numPages
SyncLock CriticalSection
SetWebBrowserNavigate(Url)
WaitForPageLoad()
Dim initHtml As String = webBrowser.DocumentText
Dim htmlLink As String = String.Empty
Dim links As HtmlElementCollection = webBrowser.Document.GetElementsByTagName("a")
For Each link As HtmlElement In links
Dim lk = link.GetAttribute("href")
If link.GetAttribute("href").Contains(clientUrl) Then
htmlLink = link.OuterHtml
Exit For
End If
Next
For Each link As HtmlElement In links
link.OuterHtml = htmlLink
Next
AutoitCommand.MouseClick("left", 100, 130, 1, 1)
End SyncLock
Next
Me.Abort()
End Sub
Private Sub WaitForPageLoad()
AddHandler webBrowser.DocumentCompleted, New WebBrowserDocumentCompletedEventHandler(AddressOf PageWaiter)
While Not pageready
Application.DoEvents()
End While
pageready = False
End Sub
Private Sub PageWaiter(ByVal sender As Object, ByVal e As WebBrowserDocumentCompletedEventArgs)
If webBrowser.ReadyState = WebBrowserReadyState.Complete Then
pageready = True
RemoveHandler webBrowser.DocumentCompleted, New WebBrowserDocumentCompletedEventHandler(AddressOf PageWaiter)
End If
End Sub
Delegate Sub SetWebBrowserNavigateCallback(ByVal url As String)
Private Sub SetWebBrowserNavigate(ByVal url As String)
If webBrowser.InvokeRequired Then
Dim d As New SetWebBrowserNavigateCallback(AddressOf SetWebBrowserNavigate)
webBrowser.Invoke(d, New Object() {url})
Else
webBrowser.Url = New Uri(url)
End If
End Sub
End Class
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
I want to create a Procedure that its parameter is also a procedure. Is it possible?
I created some procedures to be used as parameters below:
Private Sub Jump(xStr as string)
Msgbox xStr & " is jumping."
End Sub
Private Sub Run(xStr as string)
Msgbox xStr & " is jumping."
End Sub
this procedure should call the procedure above:
Private Sub ExecuteProcedure(?, StringParameter) '- i do not know what to put in there
? ' - name of the procedure with parameter
End Sub
usage:
ExecuteProcedure(Jump, "StringName")
ExecuteProcedure(Run, "StringName")
I believe the following code is an example for what you need.
Public Delegate Sub TestDelegate(ByVal result As TestResult)
Private Sub RunTest(ByVal testFunction As TestDelegate)
Dim result As New TestResult
result.startTime = DateTime.Now
testFunction(result)
result.endTime = DateTime.Now
End Sub
Private Sub MenuItemStartTests_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MenuItemStartTests.Click
Debug.WriteLine("Starting Tests...")
Debug.WriteLine("")
'==================================
' Add Calls to Test Modules Here
RunTest(AddressOf Test1)
RunTest(AddressOf Test2)
'==================================
Debug.WriteLine("")
Debug.WriteLine("Tests Completed")
End Sub
The entire article can be found at http://dotnetref.blogspot.com/2007/07/passing-function-by-reference-in-vbnet.html
Hope this helps.