Certain events not firing for combobox - vba

I have a userform with programmatically created comboboxes, which I need to run events on. As per the advise here, I created a wrapper class which I put around each such combobox ("event listener").
This is the rough content of the clsEvntListnr class module
Public WithEvents cb As MSForms.ComboBox
Public frm As UserForm
Private Sub cb_Change()
CollectGarbage
End Sub
Private Sub cb_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
'stuff
End Sub
Private Sub cb_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
'stuff
End Sub
Private Sub cb_KeyUp(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
'stuff
End Sub
Private Sub cb_DropButtonClick()
'stuff
End Sub
Private Sub cb_Enter()
'stuff
End Sub
Private Sub cb_Exit()
'stuff
End Sub
Private Sub cb_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
'stuff
End Sub
Private Sub cb_Click()
'stuff
End Sub
Private Sub cb_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
'stuff
End Sub
Private Sub cb_AfterUpdate()
'stuff
End Sub
This is how the comboboxes are created (as a part of an event for another combobox). The C_COMBOS at the end is a globally declared collection.
Private Sub cbTransaction_Change()
Dim oEvtListnr As clsEventListener
'other stuff and declarations
For i = LBound(var) To UBound(var)
Set ctrl = Me.Controls.Add("forms.combobox.1", "ctrlTb" & i, True)
Set oEvtListnr = New clsEventListener
Set oEvtListnr.cb = ctrl
Set oEvtListnr.frm = Me
C_COMBOS.Add oEvtListnr
next i
End sub
Now the behaviour is mostly as expected with the exceptions that certain event just will not fire. From the events I defined in the class module, the following do fire:
cb_KeyDown, cb_KeyPress, cb_KeyUp, cb_DropButtonClick, cb_DblClick, cb_MouseUp
while these do not:
cb_Change, cb_Click, cb_Enter, cb_Exit, cb_AfterUpdate
I have made the obvious tests by putting in breaks into these events and indeed they simply do not fire up. Any idea what may be the issue?

Related

ActiveX Combobox doesn't close automatically

I have an ActiveX Combobox in one of my main sheet which control/update a series of charts.
Private Sub cmBoxSelect_GotFocus()
Application.ScreenUpdating = False
With Me.cmBoxSelect
.List = Array("Grand Total", "Prod1", "Prod2", "Prod3", "Prod4", "Prod5")
.ListRows = 6
.DropDown
End With
Application.ScreenUpdating = True
End Sub
Private Sub cmBoxSelect_Change()
'series of codes which manipulates the charts, based on selection...
End Sub
I noticed that when I click the ComboBox and select one of its content, it leaves a blue highlight on the selection. So to prevent that, I added:
Private Sub cmBoxSelect_DropButtonClick()
Application.ScreenUpdating = False
ActiveCell.Activate
Application.ScreenUpdating = True
End Sub
It successfully removed the highlight.
However, it has a weird drawback. cmbSelect doesn't close automatically once user didn't select anything (once the combobox is active and the user click any cell in the sheet, it doesn't close out). It was working before I added the DropButtonClick event.
Did I missed anything or any wrong steps above? Thanks for your inputs!
EDIT#1
Seems I already found a solution by trial and error. I only added a blank Label and select it to remove the focus out of the ComboBox whenever there is a change. I also changed the DropButtonClick to LostFocus.
Private Sub cmBoxSelect_GotFocus()
Application.ScreenUpdating = False
With Me.cmBoxSelect
.List = Array("Grand Total", "Prod1", "Prod2", "Prod3", "Prod4", "Prod5")
.ListRows = 6
.DropDown
End With
Application.ScreenUpdating = True
End Sub
Private Sub cmBoxSelect_LostFocus()
ActiveCell.Select
End Sub
Private Sub cmBoxSelect_Change()
'series of codes which manipulates the charts, based on selection...
Me.Label1.Select
End Sub
You need to put the SelLength to 0 in multiple events to avoid highlighting:
so:
Me.cmBoxSelect.SelLength = 0
in:
Private Sub cmBoxSelect_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
Private Sub cmBoxSelect_KeyUp(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
Private Sub cmBoxSelect_LostFocus()
Private Sub cmBoxSelect_DropButtonClick()
Private Sub cmBoxSelect_Change()
Private Sub cmBoxSelect_GotFocus()
(you could add also Me.cmBoxSelect.SelStart = 0 )
Lets try this:
Not Event-triggered by a change, but by the dropbuttonclick
Private Sub changingComboBox(String s)
'series of codes which manipulates the charts, based on selection...
End Sub
Private Sub cmBoxSelect_DropButtonClick()
Dim s As String
s = cmBoxSelect.SelText
If (cmBoxSelect.SelText = cmBoxSelect.Value) Then
cmBoxSelect.Value = ""
cmBoxSelect.Value = s
Else
call changingComboBox(cmBoxSelect.Value)
End If
End Sub
How about that ?

Need help, VBA, Stoping a private sub event from another private sub

I have private sub textbox1_keydown and private sub textbox1_afterupdate. If im finish filling up textbox1 then clicking the combobox still populates it with lists. But when im finish filling up textbox1 then pressing the enter key the combobox populates a abnormal lists. cmbo4 is a sub event where it populates the combobox based on what i input in the textbox1. My codes in on a userform
Heres my code:
Private sub TextBox1_KeyDown(ByVal KeyCode As_
MSForms.ReturnInteger,ByVal Shift As Integer)
If KeyCode=13 Then
ComboBox4.Clear
Call cmbo4
ComboBox4.DropDown
ComboBox4.SetFocus
End If
End Sub
Now i have this textbox1_afterupdate event, im adding this event to avoid errors to my program when the user wants to use the mouse to click the next combobox and not by pressing enter.
Private Sub TextBox1_AfterUpdate()
ComboBox4.Clear
Call cmbo4
ComboBox4.DropDown
ComboBox4.SetFocus
End Sub
My problem is to stop the event textbox1_afterupdate to perform when the user press the enter key so that my combobox wont have abnormal lists
Option explicit
Dim InProgress as boolean 'module level variable
Private sub TextBox1_KeyDown(ByVal KeyCode As MSForms.ReturnInteger,ByVal Shift As Integer)
If KeyCode=13 Then
ComboBox4.Clear
Call cmbo4
ComboBox4.DropDown
ComboBox4.SetFocus
InProgess = true
End If
End Sub
Private Sub TextBox1_AfterUpdate()
if inProgress then 'we just updated it so don't repeat
inprogress = False 'just clear the event
else
ComboBox4.Clear
Call cmbo4
ComboBox4.DropDown
ComboBox4.SetFocus
inprogress = False 'and clear the event
End IF
End Sub

Passing MSForms.Control as argument in Word VBA

I have to set ActiveX control tab order in MS Word using VBA. So here is the basic code:
Private Sub radioFull_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, _
ByVal Shift As Integer)
If KeyCode = 9 Then
radioIntern.Activate
End If
End Sub
Problem is I have an active Restrict Editing Protection on the document set by password. Thus after starting protection, while pressing a tab on any control, it deny to functioning saying that I have a protection on the document.
So, during execution of the above function, I first have to un-protect the document, moving tab to next field and then re-protect by the following function:
Private Sub ToggleProtect()
If ActiveDocument.ProtectionType <> wdNoProtection Then
ActiveDocument.Unprotect Password:="password"
Else
ActiveDocument.Protect Password:="password", NoReset:=True, _
Type:=wdAllowOnlyFormFields, _
UseIRM:=False, EnforceStyleLock:=False
End If
End Sub
Private Sub radioFull_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, _
ByVal Shift As Integer)
If KeyCode = 9 Then
ToggleProtect
radioIntern.Activate
ToggleProtect
End If
End Sub
It works well. So I intend to shorten the main code a little bit more by something like this:
Private Sub radioFull_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, _
ByVal Shift As Integer)
tabOrder(KeyCode, controlName)
End Sub
and the tabOrder function in this case like the follwoing:
Public Sub tabOrder(K as integer,t as string)
If KeyCode = K Then
ToggleProtect
t.Activate
ToggleProtect
End If
End Sub
But I am not familiar on VBA function argument. So please tell me how to pass the argument or write the function correctly so that I can maintain tab order in MS Word form?
Even though the MS Forms controls are derived from MSForms.Control VBA is apparently unable to "cast" them to this data type. It can work with the general type, however. The trick is to declare the procedure argument as data type Variant.
While I was at it, I made another small optimization to the code by declaring an object variable of type Word.Document for passing the document to ToggleProtect. While it's unlikely, it is theoretically possible that the user will change documents during code execution, making the ActiveDocument a different one than that which triggered the code. So if you get the target document immediately then the code will always execute on the correct document, no matter which one currently has the focus.
Private Sub TextBox1_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, _
ByVal Shift As Integer)
Dim doc As Word.Document
Set doc = Me
tabOrder KeyCode, doc, Me.TextBox1
End Sub
Public Sub tabOrder(ByVal KeyCode As MSForms.ReturnInteger, _
ByRef doc As Word.Document, ByRef t As Variant)
If KeyCode = 9 Then
ToggleProtect doc
t.Activate
ToggleProtect doc
End If
End Sub
Private Sub ToggleProtect(doc As Word.Document)
If doc.ProtectionType <> wdNoProtection Then
doc.Unprotect Password:="password"
Else
doc.Protect Password:="password", NoReset:=True, _
Type:=wdAllowOnlyFormFields, _
UseIRM:=False, EnforceStyleLock:=False
End If
End Sub
In your KeyDown event, it looks like you want to pass the KeyCode and the Control. Therefore, the arguments you pass must match the signature of the tabOrder sub. Look how KeyCode is defined and copy/paste to your tabOrder sub. The second argument will be defined as Control allowing for any control to be passed. Here is an example of what I am talking about:
Private Sub radioFull_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
tabOrder KeyCode, radioFull
End Sub
Public Sub tabOrder(ByVal KeyCode As MSForms.ReturnInteger, ByRef t As MSForms.Control)
If KeyCode = 9 Then
ToggleProtect
t.Activate
ToggleProtect
End If
End Sub

Can't set Userform.KeyPreview to true

I've built a form in Excel. It consists of 3 command buttons and a frame containing checkboxes. The checkboxes are dynamically populated at userform_initialize based on tables in an excel sheet (the idea being easy user customization). The reason for the frame is that there can be a lot of checkboxes and I want the user to be able to scroll through them.
My goal now is to create keyboard shortcuts for the form. Where I get stuck is that I can't brute force write KeyDown handlers for each of the checkboxes because I don't know which ones will exist. I realize that it would also just be better if I could have the event handler at the form level. Googling has found me the form's KeyPreview property. Unfortunately, the properties window in VBA IDE doesn't show it and when I try to access it programmatically by setting Me.KeyPreview = True at userform_initialize VBA throws a compile error: "Method or data member not found" - what I would expect given it isn't in the properties window, but was worth a try.
I feel like there's something I'm obviously missing so I thought I'd ask before spending time learning how to write and then rewriting the form entirely as a class as in the MSDN example code:
https://msdn.microsoft.com/en-us/library/system.windows.forms.form.keypreview(v=vs.110).aspx.
Am I that lucky?
I confess to being at the limit of my VBA knowledge and I'm looking to go expand on it. Any general concepts or context I should red would be greatly appreciated.
UPDATE
I'm now thinking about GetAsyncKeyState and Application.Onkey.
From what I understand, GetAsyncKeyState only works within an infinite DoEvents loop. I tried initiating one hoping the form would still load but of course it didn’t – I’m stuck in the loop.
The problem with Application.Onkey is that I can't assign the event function to the key within the userform module. This puzzles me because other event handlers can go in the userform module. In fact, I’d put it in the Userform_Initialize procedure. Is it because it's not a form event but an application event?
EDIT
I seem to have something that works, but for the strange issue described here:
Event handling class will not fire unless I use a breakpoint when initializing form
Thank you #UGP
Here is an example how it could work, found here:
To put in a class named "KeyPreview":
Option Explicit
Dim WithEvents u As MSForms.UserForm
Dim WithEvents t As MSForms.TextBox
Dim WithEvents ob As MSForms.OptionButton
Dim WithEvents lb As MSForms.ListBox
Dim WithEvents dp As MSComCtl2.DTPicker
Event KeyDown(ByVal KeyCode As Integer, ByVal Shift As Integer)
'Event KeyPress(ByVal KeyAscii As Integer)
Private FireOnThisKeyCode As Integer
Friend Sub AddToPreview(Parent As UserForm, KeyCode As Integer)
Dim c As Control
Set u = Parent
FireOnThisKeyCode = KeyCode
For Each c In Parent.Controls
Select Case TypeName(c)
Case "TextBox"
Set t = c
Case "OptionButton"
Set ob = c
Case "ListBox"
Set lb = c
Case "DTPicker"
Set dp = c
End Select
Next c
End Sub
Private Sub u_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
If KeyCode = FireOnThisKeyCode Then RaiseEvent KeyDown(KeyCode, Shift)
End Sub
Private Sub t_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
If KeyCode = FireOnThisKeyCode Then RaiseEvent KeyDown(KeyCode, Shift)
End Sub
Private Sub ob_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
If KeyCode = FireOnThisKeyCode Then RaiseEvent KeyDown(KeyCode, Shift)
End Sub
Private Sub lb_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
If KeyCode = FireOnThisKeyCode Then RaiseEvent KeyDown(KeyCode, Shift)
End Sub
Private Sub dp_KeyDown(KeyCode As Integer, ByVal Shift As Integer)
If KeyCode = FireOnThisKeyCode Then RaiseEvent KeyDown(KeyCode, Shift)
End Sub
To put in the userform:
Option Explicit
Dim WithEvents kp As KeyPreview
Private Sub UserForm_Initialize()
Set kp = New KeyPreview
kp.AddToPreview Me, 114
End Sub
Private Sub kp_KeyDown(ByVal KeyCode As Integer, ByVal Shift As Integer)
MsgBox "F3 was pressed..."
End Sub
It works with TextBoxes, OptionButtons, ListBoxes and DTPickers. Other Controls that could get focus will need to be handled aswell.

UltimateTimer - C# to VB.net Conversion & Start/End Syntax Error?

Trying out Tim Lovell-Smiths' UltimateTimer project.
http://blogs.msdn.com/b/tilovell/archive/2014/01/29/a-light-weight-net-threadpool-timer-class.aspx
http://blogs.msdn.com/b/tilovell/archive/2014/01/31/sample-using-ultimatetimer-threadpooltimer.aspx
Trying to convert his C# to VB.net but his function(lambda??) in Sub Main Line 2 is not correct translation / syntax ?? - "EXPRESSION DOES NOT PRODUCE A VALUE"
1) How do I fix that Function Error in Line Two of Sub Main in VB.net
2) Is My Code properly set up to start the Timer from my SheetBeforeDoubleClick Event ?
3) Is My Code properly set up to end the Timer from my SheetBeforeDoubleClick Event ?
Imports Microsoft.Office.Interop.Excel
Imports Microsoft.Office.Core
Imports ExcelDna.Integration
Imports System.Threading
Imports UltimateTimer
Public Class AddIn
WithEvents Application As Application
Shared timer As ThreadPoolTimer
Private Shared Sub Main(ByVal args() As String)
'ERROR NEXT LINE "EXPRESSION DOES NOT PRODUCE A VALUE" - OnTimer(timer)
timer = ThreadPoolTimer.Create(Function() OnTimer(timer))
timer.SetTimer(DateTime.Now.AddSeconds(3), msPeriod:=0, acceptableMsDelay:=0)
Console.WriteLine("Press any key to stop timer")
Console.ReadLine()
timer.Dispose()
End Sub
Private Shared Sub OnTimer(timer As ThreadPoolTimer)
Console.WriteLine("Timer was called back! Resetting timer. The time is now " & DateTime.Now.ToString())
timer.SetTimer(DateTime.Now.AddSeconds(3), 0, 0)
End Sub
Private Shared Sub Endtimer(timer As ThreadPoolTimer)
timer.Dispose()
End Sub
Private Sub Application_SheetBeforeDoubleClick(Sh As Object, Target As Range, ByRef Cancel As Boolean) Handles Application.SheetBeforeDoubleClick
If Target.Address = "$A$1" Then
OnTimer(timer)
MsgBox("TIME Is On My Side!!", , "Yeppers")
ElseIf Target.Address = "$Z$1" Then
Endtimer(timer)
MsgBox("I Stopped TIME !!", , "Oh-Ho")
End If
End Sub
End Class
Thanks… :o)
EDIT: Oct 12, 2014
Okay with Dave D's help I got Tim's UltimateTimer working for me in vb.net and as part of my Excel ExcelDNA xLL AddIn.
Here is the Imports, code and sample Framework (and other code i am using for my xLL AddIN tests) for this timer to work inside a packed xLL for Excel use.
I am calling it from a double click but it could be called from a right click menu... etc.
Public Module MyFunctions
<ExcelFunction(Description:="My first .NET function")> _
Public Function dnaHello(name As String) As String
Return "Hello " & name
End Function
End Module
Public Class AddIn
Implements IExcelAddIn
WithEvents Application As Application
WithEvents Button As CommandBarButton
Public Sub AutoOpen() Implements IExcelAddIn.AutoOpen
Application = ExcelDnaUtil.Application
' Add Cell context menu
Dim ContextMenu As CommandBar
ContextMenu = Application.CommandBars("Cell")
Button = ContextMenu.Controls.Add(Type:=MsoControlType.msoControlButton, Before:=ContextMenu.Controls.Count, Temporary:=True)
With Button
.Caption = "Excel-DNA Test Button"
.Tag = "EXCEL-DNA-Test"
End With
End Sub
Public Sub AutoClose() Implements IExcelAddIn.AutoClose
Button.Delete()
End Sub
Shared timer As ThreadPoolTimer
Private Shared Sub TimerMain()
timer = ThreadPoolTimer.Create(Sub() OnTimer(timer))
timer.SetTimer(DateTime.Now.AddSeconds(3), msPeriod:=0, acceptableMsDelay:=0)
End Sub
Private Shared Sub OnTimer(timer As ThreadPoolTimer)
MsgBox("TIME Is On My Side!!" & DateTime.Now.ToString(), , "Yeppers")
timer.SetTimer(DateTime.Now.AddSeconds(3), 0, 0)
End Sub
Private Shared Sub Endtimer(timer As ThreadPoolTimer)
timer.Dispose()
End Sub
Private Sub Application_SheetBeforeDoubleClick(Sh As Object, Target As Range, ByRef Cancel As Boolean) Handles Application.SheetBeforeDoubleClick
If Target.Address = "$A$1" Then
MsgBox("TIME Is On My Side!!", , "Yeppers")
TimerMain()
ElseIf Target.Address = "$E$1" Then
Endtimer(timer)
MsgBox("I Stopped TIME !", , "Oh-Ho")
End If
End Sub
Private Sub Button_Click(Ctrl As CommandBarButton, ByRef CancelDefault As Boolean) Handles Button.Click
Application.StatusBar = "Excel-DNA Test Button - Clicked!"
End Sub
End Class