Is there a way to add an event handler for a control at runtime?
Regard this code (in the form I have only TextBox1):
Option Compare Database
Option Explicit
Dim WithEvents tb As Access.TextBox
Private Sub Form_Load()
set tb = TextBox1
End Sub
Private Sub tb_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
Debug.Print "tb_MouseDown"
End Sub
Private Sub TextBox1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
Debug.Print "TextBox1_MouseDown"
End Sub
With that code, the two handlers are called.
If I remove the handler TextBox1_MouseDown, the tb_MouseDown is not fired.
Related
I designed code for a GUI grade Calculator but now I am being asked to add 1. create a function that will contain all of your data validation code. The function should return true if all data checks have passed or a false if any of the data is invalid. If the data is valid (true returned), add the number to the list box, if it is not valid (false returned), show an error message.2)Add a Sub procedure that will reset the form fields back to their initial state. Call this sub procedure when the clear button is clicked.
2.add a Sub procedure that will reset the form fields back to their initial state. Call this sub procedure when the clear button is clicked.
create a function that will count the 90s in the listbox. Pass the listbox in a a parameter and loop the contents to count each of the 90s in the listbox. Return the count of the 90s in the list box to the caller. Use it as input in the re-write eligibility check.
This is my Code.
Public Class Form1
Private Sub BuGrade_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles BuGrade.Click
gradeList.Items.Add(txtgrade.Text)
txtgrade.Clear()
End Sub
Private Sub BuAverage_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles BuAverage.Click
Dim total As Double
Dim avg As Double
Dim grade As Double
Dim gradecount As Integer
For gradecount = 0 To gradeList.Items.Count - 1
grade = gradeList.Items(gradecount)
total += grade
Next
avg = total / gradeList.Items.Count
lblR.Text = "The final total score is " & total & vbCrLf & "The Average score is " & avg
End Sub
Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
lblR.Text = String.Empty
End Sub
End Class
I use:
- Win 7x64;
- Access - 2016;
I try to solve my problem with the following code.
Form1
Option Compare Database
Option Explicit
Public statusBool As Boolean
Public numProc As Integer
' `Button pressed`.
Private Sub btnStart_Click()
numProc = 0
statusBool = True
Call Process(statusBool, numProc)
End Sub
' Process
Public Sub Process(statusBool As Boolean, numProc As Integer)
If statusBool = True Then
Me.txtProcessFrm = "ProcessNum - " & numProc + 1
Call SleepFor(1000) '1 seconds delay
Call Process(statusBool, numProc)
End If
End Sub
'
Private Sub btnStart_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
statusBool = False
numProc = 0
Call Process(statusBool, numProc)
End Sub
Public Sub SleepFor(ByVal MilliSeconds As Long)
Sleep MilliSeconds
End Sub
Module1
Option Compare Database
Option Explicit
Private Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Question
Will my solution be correct for this task or are there simpler ways to solve this problem?
Update_1
The code does not start.
I get an error Sub or Function not defined.
Update_2
Module Module1.
Replaced Private to Public.
It was
Private Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
It became
Public Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Problem.
When I click the button btnStart_Click the file hangs
Update_3
Modified Process (statusBool As Boolean, numProc As Integer)
It became.
' Process
Public Sub Process(statusBool As Boolean, numProc As Integer)
If statusBool = True Then
Do
Sleep 1000
DoEvents
Loop Until Me.txtProcessFrm = "ProcessNum - " & numProc + 1
Call Process(statusBool, numProc)
End If
End Sub
Problem.
It seems the pause works, but the logic itself does not work.
In other words, the text field is not filled with text.
If you release the button, the cycle continues to work.
The chain of event for clicking a button follows as this.
MouseDown → MouseUp → Click → DblClick → Click
In your code, the loop will never stop because your statusBool will always be true causing infinite loop and that's probably why it's hanging even if you release the mosue.
you can however try this mouse down => mouse up:
Private Sub btnStart_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
statusBool = True
Call Process(0)
End Sub
Private Sub btnStart_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
statusBool = False
End Sub
Public Sub Process(numProc As Integer)
If statusBool Then
numProc = numProc + 1
Me.txtProcessFrm = "ProcessNum - " & numProc
Sleep 1000
DoEvents
Call Process(numProc)
End If
End Sub
more here:
https://learn.microsoft.com/en-us/office/vba/api/access.commandbutton.click
I have this class module inside my Access database:
Option Compare Database
Public Event BeforeCalc()
Public Sub Calculate(ByVal i As Integer, ByVal y As Integer)
RaiseEvent BeforeCalc
Calculate = i + y
End Sub
Private Sub Class_Initialize()
Debug.Print "Inside construcotr"
End Sub
Then, inside a custom form:
Option Compare Database
Private WithEvents math As MyMath
Private Sub btnCalculate_Click()
Dim result As Integer
Set result = math.Calculate(CInt(txtI.Text), CInt(txtY.Text))
End Sub
Private Sub Form_Load()
Set math = New MyMath
End Sub
Private Sub math_BeforeCalc()
MsgBox "About to Calc!", vbInformation
End Sub
When I click the form button btnCalculate I got this error at math.Calculate:
"Compile error. Expected function or variable."
What's wrong with my code?
Since it is a function so it should return something, in your case an integer and also you should specify the Function keyword.
replace the code :
Public Sub Calculate(ByVal i As Integer, ByVal y As Integer)
RaiseEvent BeforeCalc
Calculate = i + y
End Sub
with :
Public Function Calculate(ByVal i As Integer, ByVal y As Integer) as Integer
RaiseEvent BeforeCalc
Calculate = i + y
End Sub
You have defined Calculate as a Sub, try defining it as a Function:
Public Function Calculate(ByVal i As Integer, ByVal y As Integer) as Integer
RaiseEvent BeforeCalc
Calculate = i + y
End Function
Also, don't set the result:
Private Sub btnCalculate_Click()
Dim result As Integer
result = math.Calculate(CInt(txtI.Text), CInt(txtY.Text))
End Sub
I am trying to get the DB to close after 2 minutes have passed by (for testing purposes I am just making a MsgBox appear after the 2 minutes). To do this, I have a main form called DTForm and a hidden form called Timer. Both forms open on opening the DB but Timer opens in hidden mode.
AutoExec Macro:
1. Open DTForm (the main form)
2. Open Timer (the hidden form)
Module 1:
Option Compare Database
Option Explicit
Public timer_start As Date
Public timer_end As Date
Public timer_diff As Integer
DTForm (users will only see this form)
Option Compare Database
Option Explicit
Public Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
timer_start = Time
timer_end = DateAdd("n", 2, timer_start)
End Sub
Timer (the hidden form):
Option Compare Database
Option Explicit
Public Sub Form_Open(Cancel As Integer)
timer_start = Time
timer_end = DateAdd("n", 2, Time)
End Sub
Public Sub Form_Load()
timer_start = Time
timer_end = DateAdd("n", 2, Time)
End Sub
Public Sub Form_Timer()
timer_diff = DateDiff("n", timer_end, Time)
If timer_diff >= 0 Then
'Application.Quit
MsgBox "timer reached 0"
timer_start = Time
timer_end = DateAdd("n", 2, Time)
End If
End Sub
Update - the problem: So now the problem is the mouse. It looks like just moving the mouse around the form does nothing. However, moving the mouse from the navigation pane to the form and back (in and out) does trigger the mouse movement. This seems really counter-intuitive - why not just consider all mouse movements?
Notes: Added Option Explicit to the tops of both forms and fixed some missing variable declarations.
This seems to be a variable scope issue to me. By default your variables are local.
Unless timer_end is declared as a global or public variable, it is out of scope as soon as you leave the sub where it is defined. So the timer_end in Form_timer is a totally different variable than the one in your MouseMove event (even though they have the same name).
This is one reason why many people put "option explicit" at the beginning of their code as it forces you to declare your variables.
You could also pursue a design strategy where you pass the variable as a parameter instead of making it global or public
If you want to go through with it, the Form_MouseMove event must be in every form, because only the active form receives the MouseMove event.
Note: you actually don't need the timer_start variable at all. You can remove it and keep only:
Public Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
timer_end = DateAdd("n", 2, Time)
End Sub
Or somewhat cleaner:
Public Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Call UpdateTimer()
End Sub
and in your Module1:
Public Sub UpdateTimer()
timer_end = DateAdd("n", 2, Time)
End Sub
in case you decide to change the time interval...
Note:
timer_diff should be a local variable in Timer.Form_Timer(), since it's only used there.
DateDiff("s", timer_end, Time) will return a negative value until the 10 seconds of inactivity, then the condition must be changed to >= and the time interval to 1000 (1 second) 1 millisecond is too fast.
Also to make sure the variables are ok add option explicit clause
Option Compare Database
Option Explicit
Dim timer_start as Variant
Dim timer_end as Variant
Public Sub Form_Open(Cancel As Integer)
timer_start = Time
End Sub
Public Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
timer_start = Time
timer_end = DateAdd("s", 10, timer_start)
Me.Label6.Caption = timer_start
Me.Label8.Caption = timer_end
End Sub
Public Sub Form_Timer()
If DateDiff("s", timer_end, Time) >= 0 Then
MsgBox "timer reached 0"
End If
End Sub
I have a form which includes a data sheet. I would like to make it possible for a user to select multiple rows, click on a button and have some sql query run and perform some work on those rows.
Looking through my VBA code, I see how I can access the last selected record using the CurrentRecord property. Yet I don't see how I can know which rows were selected in a multiple selection. (I hope I'm clear...)
What's the standard way of doing this? Access VBA documentation is somewhat obscure on the net...
Thanks!
I used the technique similar to JohnFx
To trap the Selection height before it disappears I used the Exit event of the subform control in the Main form.
So in the Main form:
Private Sub MySubForm_Exit(Cancel As Integer)
With MySubForm.Form
m_SelNumRecs = .SelHeight
m_SelTopRec = .SelTop
m_CurrentRec = .CurrentRecord
End With
End Sub
Here is the code to do it, but there is a catch.
Private Sub Command1_Click()
Dim i As Long
Dim RS As Recordset
Dim F As Form
Set F = Me.sf.Form
Set RS = F.RecordsetClone
If F.SelHeight = 0 Then Exit Sub
' Move to the first selected record.
RS.Move F.SelTop - 1
For i = 1 To F.SelHeight
MsgBox RS![myfield]
RS.MoveNext
Next i
End Sub
Here's the catch:
If the code is added to a button, as soon as the user clicks that button, the selection is lost in the grid (selheight will be zero). So you need to capture that info and save it to a module level variable either with a timer or other events on the form.
Here is an article describing how to work around the catch in some detail.
http://www.mvps.org/access/forms/frm0033.htm
Catch 2: This only works with contiguous selections. They can't select mutliple non-sequential rows in the grid.
Update:
There might be a better event to trap this, but here is a working implementation using the form.timerinterval property that i have tested (at least in Access 2k3, but 2k7 should work just fine)
This code goes in the SUBFORM, use the property to get the selheight value in the master form.
Public m_save_selheight As Integer
Public Property Get save_selheight() As Integer
save_selheight = m_save_selheight
End Property
Private Sub Form_Open(Cancel As Integer)
Me.TimerInterval = 500
End Sub
Private Sub Form_Timer()
m_save_selheight = Me.selheight
End Sub
I've tried doing something like that before, but I never had any success with using a method that required the user to select multiple rows in the same style as a Windows File Dialog box (pressing Ctrl, Shift, etc.).
One method I've used is to use two list boxes. The user can double click on an item in the left list box or click a button when an item is selected, and it will move to the right list box.
Another option is to use a local table that is populated with your source data plus boolean values represented as checkboxes in a subform. After the user selects which data they want by clicking on checkboxes, the user presses a button (or some other event), at which time you go directly to the underlying table of data and query only those rows that were checked. I think this option is the best, though it requires a little bit of code to work properly.
Even in Access, I find sometimes it's easier to work with the tables and queries directly rather than trying to use the built-in tools in Access forms. Sometimes the built-in tools don't do exactly what you want.
A workaround to the selection loss when the sub form loses the focus is to save the selection in the Exit event (as already mentioned by others).
A nice addition is to restore it immediately, using timer, so that the user is still able to see the selection he made.
Note: If you want to use the selection in a button handler, the selection may not be restored already when it executes. Make sure to use the saved values from the variables or add a DoEvents at the beginning of the button handler to let the timer handler execute first.
Dim m_iOperSelLeft As Integer
Dim m_iSelTop As Integer
Dim m_iSelWidth As Integer
Dim m_iSelHeight As Integer
Private Sub MySubForm_Exit(Cancel As Integer)
m_iSelLeft = MySubForm.Form.SelLeft
m_iSelTop = MySubForm.Form.SelTop
m_iSelWidth = MySubForm.Form.SelWidth
m_iSelHeight = MySubForm.Form.SelHeight
TimerInterval = 1
End Sub
Private Sub Form_Timer()
TimerInterval = 0
MySubForm.Form.SelLeft = m_iSelLeft - 1
MySubForm.Form.SelTop = m_iSelTop
MySubForm.Form.SelWidth = m_iSelWidth
MySubForm.Form.SelHeight = m_iSelHeight
End Sub
There is another solution.
The code below will show the number of selected rows as soon as you release the mouse button.
Saving this value will do the trick.
Private Sub Form_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
MsgBox Me.SelHeight
End Sub
Use a Global variable in the form, then refer to that in the button code.
Dim g_numSelectedRecords as long
Private Sub Form_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
g_numSelectedRecords = Me.SelHeight
End Sub
Dim formRecords As DAO.Recordset
Dim i As Long
Set formRecords = Me.RecordsetClone
' Move to the first record in the recordset.
formRecords.MoveFirst
' Move to the first selected record.
formRecords.Move Me.SelTop - 1
For i = 1 To numSelectedRecords
formRecords.Edit
formRecords.Fields("Archived") = True
formRecords.Update
formRecords.MoveNext
Next i
Why not use an array or recordset and then every time the user clicks on a row (either contiguous or not, save that row or some identifier into the recordset. Then when they click the button on the parent form, simply iterate the recordset that was saved to do what you want. Just don't forget to clear the array or recordset after the button is clicked.?
Another workaround to keeping the selection while attempting to execute a procedure - Instead of leaving the datasheet to activate a button, just use the OnKeyDown event and define a specific keycode and shift combination to execute your code.
The code provided by JohnFx works well. I implemented it without a timer this way (MS-Access 2003):
1- Set the Form's Key Preview to Yes
2- put the code in a function
3- set the event OnKeyUp and OnMouseUp to call the function.
Option Compare Database
Option Explicit
Dim rowSelected() As String
Private Sub Form_Load()
'initialize array
ReDim rowSelected(0, 2)
End Sub
Private Sub Form_Current()
' if cursor place on a different record after a selection was made
' the selection is no longer valid
If "" <> rowSelected(0, 2) Then
If Me.Recordset.AbsolutePosition <> rowSelected(0, 2) Then
rowSelected(0, 0) = ""
rowSelected(0, 1) = ""
rowSelected(0, 2) = ""
End If
End If
End Sub
Private Sub Form_KeyUp(KeyCode As Integer, Shift As Integer)
rowsSelected
If KeyCode = vbKeyDelete And Me.SelHeight > 0 Then
removeRows
End If
End Sub
Private Sub Form_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
rowsSelected
End Sub
Sub rowsSelected()
Dim i As Long, rs As DAO.Recordset, selH As Long, selT As Long
selH = Me.SelHeight
selT = Me.SelTop - 1
If selH = 0 Then
ReDim rowSelected(0, 2)
Exit Sub
Else
ReDim rowSelected(selH, 2)
rowSelected(0, 0) = selT
rowSelected(0, 1) = selH
rowSelected(0, 2) = Me.Recordset.AbsolutePosition ' for repositioning
Set rs = Me.RecordsetClone
rs.MoveFirst ' other key touched caused the pointer to shift
rs.Move selT
For i = 1 To selH
rowSelected(i, 0) = rs!PositionNumber
rowSelected(i, 1) = Nz(rs!CurrentMbr)
rowSelected(i, 2) = Nz(rs!FutureMbr)
rs.MoveNext
Next
Set rs = Nothing
Debug.Print selH & " rows selected starting at " & selT
End If
End Sub
Sub removeRows()
' remove rows in underlying table using collected criteria in rowSelected()
Me.Requery
' reposition cursor
End Sub
Private Sub cmdRemRows_Click()
If Val(rowSelected(0, 1)) > 0 Then
removeRows
Else
MsgBox "To remove row(s) select one or more sequential records using the record selector on the left side."
End If
End Sub