VBA event raise only once (intermittent) - vba

Context
My VBA code often replace worksheets inside the Workbook. Therefore I can't use code directly in the worksheet module as it would be eventually deleted in the process.
I use a user-defined class to handle my events (strongly inspired from Chip Pearson's withevents article)
Public WithEvents ws As Worksheet
Private Sub ws_Activate()
If ActiveSheet.Name = FREEBOM_SHEET_NAME Then
Call FREEBOM_Worksheet_Activate_Handler
End If 'ActiveSheet.Name = FREEBOM_SHEET_NAME
End Sub
Private Sub ws_Change(ByVal Target As Range)
'MsgBox Target.Parent.Name
If Target.Parent.Name = FREEBOM_SHEET_NAME Then
Call FREEBOM_Worksheet_Change_Handler(Target)
End If 'Target.Parent.Name = FREEBOM_SHEET_NAME
If Target.Parent.Name = BOM_SHEET_NAME Then
Call BOM_Worksheet_Change_Handler(Target)
End If 'Target.Parent.Name = BOM_SHEET_NAME
End Sub
The class is being instantiated when the workbook is opened.
Private Sub Workbook_Open()
Dim WSObj_FreeBOM As FreeBOM_CWorkSheetEventHandler
Dim WSObj_BOM As FreeBOM_CWorkSheetEventHandler
If Freebom_EventCollection Is Nothing Then
Set Freebom_EventCollection = New Collection
End If
Set WSObj_FreeBOM = New FreeBOM_CWorkSheetEventHandler
Set WSObj_FreeBOM.ws = Sheets(FREEBOM_SHEET_NAME)
Set WSObj_BOM = New FreeBOM_CWorkSheetEventHandler
Set WSObj_BOM.ws = Sheets(BOM_SHEET_NAME)
Freebom_EventCollection.Add Item:=WSObj_FreeBOM, Key:=Sheets(FREEBOM_SHEET_NAME).Name
Freebom_EventCollection.Add Item:=WSObj_BOM, Key:=Sheets(BOM_SHEET_NAME).Name
End Sub
During my reading on the subject, I saw that linking your object to a public collection (the declaraiton is in another module (an ordinary module - not a Worksheet module and not a Class module). : Public Freebom_EventCollection As Collection would keep my instance alive even if the execution leaves the scope of the current initianlization function.
Problem Description
In most scenario, I will get only one ws_change event being raised. After that, the sheet behave as if there is no event handler in my code. Nothing is being raised, not just the worksheet events.
I have look at Application.EnableEvents but it is always set to True after the first run.
Also, when I use the build in Private Sub Worksheet_Change(ByVal Target As Range) function it worked well.
To me it is probably linked to the fact that I use a class and it is not staying alive after the first run. But then, I do not know what I am doing wrong.
Thank you in advance for you time and help in this matter.

you need to declare a module level Public instance of the Collection in an ordinary module (not a Worksheet module and not a Class module). You may as well put the code to manage the collection there as well and simply have calls from the event handlers of the worksheet modules. You may need to re-initialise the collection whenever you delete a sheet as this will probably trigger a re-compile and reset your project, which will terminate your objects.
Once you have the collection in the standard module, you can monitor its life cycle by adding a watch (SHIFT-F9 in VBE). Then you can keep track of exactly what is going on.

Related

Terminate method not called in Access 2021

Anyone else finding that their Terminate() method in Access isn't being called?
Here's my code for my cBusyPointer class with the comments removed for brevity:
Option Compare Database ' Use database order for string comparisons
Option Explicit ' Declare EVERYTHING!
Option Base 1 ' Arrays start at 1
Public Sub show()
DoCmd.hourGlass True
End Sub
Private Sub Class_Terminate()
DoCmd.hourGlass False
End Sub
Typical usage is:
Sub doTehThings()
Dim hourGlass As New cBusyPointer
hourGlass.show()
' Do all teh things
End Sub
In previous versions, this class would restore the hourglass whenever the object went out of scope and was destroyed.
I even tried to manually destroy my hourglass object:
Sub doTehThings()
Dim hourGlass As cBusyPointer
Set hourGlass = New cBusyPointer
hourGlass.show()
' Do all teh things
Set hourGlass = Nothing
End Sub
The only way to fix this is to add a hide() method and call that.
Has anyone else encountered this problem?
I cannot replicate the issue. The Terminate() method is called upon reaching the Set hourGlass = Nothing.
A couple of points:
Dim hourGlass As New cBusyPointer
This will create a new instance every time you call the hourGlass variable even to set it to Nothing. See the answer in the link below for additional info:
What's the difference between Dim As New vs Dim / Set
You should always use Dim/Set when working with objects.
hourGlass.show()
This does not even compile in VBA. Subs do not accept parentheses even when arguments are being expected, unless they are preceded with the Call keyword.
Lastly, the cleanest way to reference an object is to access it using the With statement which ensures the object is terminated when the End With statement is reached.
With New cBusyPointer
.show
End With

VBA - Load event code not running

I have a very simple form that, when loaded, should create a new object Thing that is defined in a specific Class Module. The UF also has several buttons associated to different functions.
This is the UF's code associate to the load event:
Option Explicit
Private mth As Thing
Private Sub UserForm_Load()
Set mth = New Thing
mth.Name = InputBox("Enter a name for the Thing")
End Sub
If I F5 directly on this, the UF shows up but the code doesn't run furth and the Thing object mth is not even created ...
I also tried to call the form from a module with the following code but the result was the same:
Sub test()
Dim uf As Object
Set uf = New Dinamico 'this is the name of the UserForm
Load uf
End Sub
As result, I would like that each time that the form is loaded, a new mth was created and an InputBox asking for the name appeared. I have the feeling to be missing something very stupid...could you help me out please ?
Write your code within
Private Sub UserForm_Initialize()
End Sub
UserForm_Load is in VB.Net while in VBA its UserForm_Initialize.

Excel spreadsheet events - how to create generic MSForms.Control event handler for all ActiveX controls?

Background/Introduction
In an effort to tame wild ActiveX objects, I am implementing custom event handlers which I can assign to each ActiveX control.
I currently have implemented one such as the class, WSCheckboxEventHandler:
Option Explicit
Private WithEvents m_ole As MSForms.CheckBox
Private m_ws As Worksheet
Public Sub init(p_SourceOLE As MSForms.CheckBox, p_ws As Worksheet)
Set m_ole = p_SourceOLE
Set m_ws = p_ws
End Sub
Private Sub m_ole_Click()
Debug.Print "Checkbox click for " + m_ole.name
m_ole.Left = m_ole.Left
m_ole.Width = m_ole.Width
m_ole.Height = m_ole.Height
m_ole.Top = m_ole.Top
m_ws.Shapes(m_ole.name).ScaleHeight 1.25, msoFalse, msoScaleFromTopLeft
m_ws.Shapes(m_ole.name).ScaleHeight 0.8, msoFalse, msoScaleFromTopLeft
End Sub
In a worksheet module, with m_WSObjectEventHandler as a private variable, the following sets the handler up perfectly:
Set m_WSObjectEventHandler = New WSCheckboxEventHandler
m_WSObjectEventHandler.init Sheet1.chk_DraftMode, Sheet1
Basically this is a hack work around for the objects resizing visually - by calling these commands I force them to remain sized correctly. The linked question above details this problem.
However, this requires me to create a separate event handler for each type of control. I have about 7 now, so I've created a separate class which basically serves as a pseudo factory for these, passing in the worksheet, then iterating through all the ActiveX objects for it and creating the appropriate handler via an ugly select statement:
For Each mOLE In m_ws.OLEObjects
Select Case TypeName(mOLE.Object)
Case "CheckBox"
Set mCheckBoxHndlr = New WSCheckboxEventHandler
mCheckBoxHndlr.init mOLE.Object, m_ws
m_CheckBoxes.Add mCheckBoxHndlr
'etc... there are a lot of these!
Case Default
Debug.Print "Default"
End Select
Next mOLE
This lets me however have a single worksheet variable contain all the event handlers as member collections. Ugly? Yes, but it will allow better code reuse.
Question
I want to be able to implement a single event handler for all ActiveX object types (there are many, the factory type class above is going to have a huge ugly switch statement). Basically changing MSForms.CheckBox to MSForms.Control in the above event handler. It'd be great to not have to copy the same code into 5+ event handlers and maintain that. Not to mention avoiding the ugly select statement.
How can I refer to the control as a valid MSForms.Control object and consequentially setup the event handler? I basically want to typecast the MSForms.CheckBox into a MSForms.Control object.
Alternatively, is it possible to get the MSForms.Control object somehow? It doesn't seem to be part of the OLEObject.Object at all (I get type errors doing this).

Excel VBA - QueryTable AfterRefresh function not being called after Refresh completes

I am developing an Excel (2010+) Application using VBA and have run into an issue where the AfterRefresh event function is not being invoked once the query finishes executing.
I have not been able to find many decent resources or documentation for how to have this event function triggered in a Class Module. I decided to use the Class Module design route instead of putting the event handlers in the worksheet after receiving a response to an earlier question about QueryTables (found here Excel VBA AfterRefresh).
Here is the code for my Class Module called CQtEvents
Option Explicit
Private WithEvents mQryTble As Excel.QueryTable
Private msOldSql As String
' Properties
Public Property Set QryTble(ByVal QryTable As QueryTable): Set mQryTble = QryTable:
End Property
Public Property Get QryTble() As QueryTable: Set QryTble = mQryTble:
End Property
Public Property Let OldSql(ByVal sOldSql As String): msOldSql = sOldSql:
End Property
Public Property Get OldSql() As String: OldSql = msOldSql:
End Property
Private Sub Class_Initialize()
MsgBox "CQtEvents init"
End Sub
' Resets the query sql to the original unmodified sql statement
' This method is invoked when the Refresh thread finishes executing
Private Sub mQryTble_AfterRefresh(ByVal Success As Boolean)
' Problem is here
' This function is never called :( Even if the query successfully runs
Me.QryTble.CommandText = Me.OldSql
End Sub
Here is a quick snapshot of the code the creates an instance of this class, finds a relevant QueryTable, then calls Refresh
Option Explicit
Sub RefreshDataQuery()
'Dependencies: Microsoft Scripting Runtime (Tools->References) for Dictionary (HashTable) object
'From MGLOBALS
cacheSheetName = "Cache"
Set cacheSheet = Worksheets(cacheSheetName)
Dim querySheet As Worksheet
Dim interface As Worksheet
Dim classQtEvents As CQtEvents
Set querySheet = Worksheets("QTable")
Set interface = Worksheets("Interface")
Set classQtEvents = New CQtEvents
Dim qt As QueryTable
Dim qtDict As New Scripting.Dictionary
Set qtDict = UtilFunctions.CollectAllQueryTablesToDict
Set qt = qtDict.Item("Query from fred2")
''' Building SQL Query String '''
Dim sqlQueryString As String
sqlQueryString = qt.CommandText
Set classQtEvents.QryTble = qt
classQtEvents.OldSql = sqlQueryString ' Cache the original query string
QueryBuilder.BuildSQLQueryStringFromInterface interface, sqlQueryString
' Test message
MsgBox sqlQueryString
qt.CommandText = sqlQueryString
If Not qt Is Nothing Then
qt.Refresh
Else
' ... Error handling code here...
End If
''' CLEAN UP '''
' Free the dictionary
Set qtDict = Nothing
End Sub
Also here is a screenshot of the Module structure http://imgur.com/8fUcfLV
My first thought on what might be the issue was passing the QueryTable by value. I am not the most experienced VBA developer, but I reasoned this would create a copy and be calling the event on an unrelated table. However, this was not the case and passing by Reference did not fix the problem either.
Also the query is confirmed to run successfully as the data is correctly showing up and being refreshed.
EDIT
I added the BeforeRefresh event function to CQtEvents class Module and confirmed this function is called once Refresh is called
Private Sub mQryTble_BeforeRefresh(Cancel As Boolean)
MsgBox "Start of BeforeRefresh"
End Sub
How might I alter this code get my QueryTable from the QTableModule's RefreshDataQuery() Sub routine to have the AfterRefresh function invoked when the query is successfully ran?
How to catch the AfterRefresh event of QueryTable?
Explanation: in your situation, before event was fired you lost reference of your QueryTable by setting it to nothing when you made cleaning or procedure ended.
General solution: you must be sure that your code is still running and/or you need to keep any references to your QueryTable.
1st solution. When calling QT.Refresh method set the parameter to false in this way:
qt.Refresh false
which will stop further code execution until your qt is refreshed. But I don't consider this solution to be the best one.
2nd solution. Make your classQtEvents variable public and after RefreshDataQuery sub is finished check the status with some other code.
in you CQtEvents class module add the following public variable:
Public Refreshed As Boolean
in your BeforeRefresh event add this:
Refreshed = False
in your AfterRefresh event add this line of code:
Refreshed = True
Make your classQtEvents variable declaration public. Put this before Sub RefreshDataQuery()
Public classQtEvents as CQtEvents
but remove appropriate declaration from within your sub.
Now, even your sub is finished you will be able to check status of refreshment by checking .Refreshed property. You could do it in Immediate or within other Sub. This should work for Immediate:
Debug.Print classQtEvents.Refreshed
3rd solution. (a bit similar to 1st one) Follow steps 1 to 3 from 2nd solution. After you call qt.Refresh method you could add this loop which will stop further code execution until qt is refreshed:
'your code
If Not qt Is Nothing Then
qt.Refresh
Else
' ... Error handling code here...
End If
'checking
Do Until classQtEvents.Refreshed
DoEvents
Loop
Final remark. I hope I didn't mixed up qt variable with classQtEvents variable. I didn't tried and tested any solution using your variables but wrote all above with referenced to code I use.
A github repo that demonstrates the minimum code needed to get this working can be found here.
As mentioned, if your event handler isn't in scope, or your QueryTable reference is lost, you won't catch the event. The key factors to ensuring you catch the event are:
Declare a global variable of your event-handling class module's type outside of any subroutines/methods, at the top of a file (I chose the ThisWorkbook file).
Add a Workbook_Open event handler and instantiate that variable there, so that it is available immediately and will remain in scope (since it's global).
At that point, or at any downstream point when you have a QueryTable you're interested in, pass that QueryTable to the global instance to wire up its events.
(It took me a couple tries to figure this out myself, when someone pointed me in this direction as an answer to this question.)

Error capturing onreadystatechange of MSXML2.DOMDocument in VBA

I am getting an error trying to arrange asynchronous loading and parsing of an XML document in VBA using a wrapper class.
Following the ideas described in this msdn article and this tutorial which have worked perfectly for asynchronous handling of MSXML2.XMLHTTP40.send method I attempted to do a similar thing for DOMDocument.loadXML.
Here is the code from the wrapper class DOMMonitor
Private domDoc As MSXML2.DOMDocument
Public Event onXmlLoadComplete(d As MSXML2.DOMDocument)
Public Sub loadXML(XmlFilePath As String)
Set domDoc = CreateObject("MSXML2.DOMDocument")
domDoc.async = True
domDoc.onreadystatechange = Me ' error occurs here
domDoc.Load XmlFilePath
End Sub
Public Sub onLoadComplete()
If domDoc.readyState = "4" Then
RaiseEvent onXmlLoadComplete(domDoc)
End If
End Sub
I have made onLoadComplete the default method by setting VB_UserMemId = 0, so it is supposed to be invoked when domDoc fires onreadystatechange .
However when I invoke loadXML
Dim dm As DomMonitor
Set dm = New DomMonitor
dm.loadXML txtXMLData
i get the following runtime error in this line:
domDoc.onreadystatechange = Me
This object cannot sink the 'onreadystatechange' event. An error occurred marshalling the object's IDispatch interface
What am I doing wrong and is there a good workaround here?
Thanks in advance.
P.S. The reason I am republishing the event is that I do not necessarily want use the default method of the final subscriber for this purpose. However, as things stand now I do not even get to that stage.
The way I read that msdn article is that to assign a wrapper class to the readystatechange, the object has to be either an IXMLHTTPRequest or an IServerXMLHTTPRequest object (bullet 3). Since your object is a DOMDocument, readystatechange doesn't accept an object.
However, you can instantiate a DOMDocument WithEvents (bullet 2), making the other way redundant, I guess. I don't have an xml file large enough to test, but I think this should work. I assume that if the class loses scope, all bets are off, so I made it a global variable.
In a standard module
Public clsDOMMonitor As CDOMMonitor
Sub test()
Set clsDOMMonitor = New CDOMMonitor
clsDOMMonitor.loadXML "C:\Users\dkusleika\Downloads\wurfl-2.3.xml"
End Sub
In CDOMMonitor class
Private WithEvents mDoc As MSXML2.DOMDocument
Private Sub mDoc_onreadystatechange()
If mDoc.readyState = 4 Then
MsgBox "second"
End If
End Sub
Public Sub loadXML(XmlFilePath As String)
Set mDoc = New MSXML2.DOMDocument
mDoc.async = True
mDoc.Load XmlFilePath
MsgBox "first"
End Sub
I assume that setting async to True is all that is needed for this to work properly. My 100k xml file is probably done so fast that that the event never gives up control. But if you had a sufficiently large xml file, I think you would get "first" before "second".
Change the class' Instancing property from Private to PublicNotCreatable when late binding, whilst also applying the tweak which you have mentioned.
Use the above example when early binding (as in your case).