Control VBA UserForm via VB6 with "Type Mismatch" Error

Question

I am trying to develop a VB6 program(DLL) that can control VBA UserForm. Please refer to below as my situation.

1. Create a VBA UserForm, and during "UserForm_Initialize" sub, pass "Me" as a parameter to DLL.
2. DLL dynamic Add controls, but with "declare by Object"(can't specific to MSForms object type)
3. It needs to declare by "WithEvents" for object methods, but during assign, the Error Code:13, "Type Mismatch" will occur.
4. check by "TypeOf IS" is mismatch neither.

Does anyone know how to assign an object "WithEvents" by VB6?

please refer to below as source code, or you may download it from HERE

Any reply will be appreciated!

in vb6, "ControlsAddClass" Class

Option Explicit
Public WithEvents cmdbtnTest As MSForms.CommandButton
'Public cmdbtnTest As Object
Function VBAUserFormControlAdd(objRunForm As MSForms.UserForm)
    Dim lblTypeOfIsDesc As Object, lblTypeIsResult As Object

    With objRunForm
        Set lblTypeOfIsDesc = .Controls.Add("Forms.Label.1", "lblTypeOfIsDesc", True)
        With lblTypeOfIsDesc
            .Caption = "TypeOf cmdbtnTest Is MSForms.CommandButton: "
            .Width = 360
            .AutoSize = True
            .BorderStyle = 1
            .Visible = True
        End With
        Set lblTypeIsResult = .Controls.Add("Forms.Label.1", "lblTypeIsResult", True)
        With lblTypeIsResult
            .Left = lblTypeOfIsDesc.Left + lblTypeOfIsDesc.Width + 10
            .Width = 180
            .BorderStyle = 1
            .Visible = True
        End With
    
        Set cmdbtnTest = .Controls.Add("Forms.CommandButton.1", "cmdbtnTest", True)
        With cmdbtnTest
            .Top = lblTypeOfIsDesc.Top + lblTypeOfIsDesc.Height + 10
            .Caption = "Test Btn"
        End With
        
        With lblTypeIsResult
            .Caption = TypeOf cmdbtnTest Is MSForms.CommandButton
            .AutoSize = True
        End With
    End With 
End Function
Private Sub cmdbtnTest_Click()
    MsgBox "Test!"
End Sub

in VBA Module,

Option Explicit
Const strDLLName As String = "VB6_VBA_UserForm_Control"

Function UserFormControlsAdd()
    Dim objReferenceRun As Variant, blnReferenceExist As Boolean
    
    For Each objReferenceRun In ThisWorkbook.VBProject.References
        If objReferenceRun.Description = Replace(strDLLName, "_", " ") Then
            blnReferenceExist = True
            Exit For
        End If
    Next
    If Not blnReferenceExist Then RegMount
    TestUserForm.Show
End Function
Function RegMount()
    Dim strDLLFilePath As String
    Dim FSO As New Scripting.FileSystemObject
    
    strDLLFilePath = ThisWorkbook.Path & "\VB6_VBA_UserForm_Control.dll"
    If FSO.FileExists(ThisWorkbook.Path & "\VB6_VBA_UserForm_Control.dll") Then
        Shell "Regsvr32 /s """ & strDLLFilePath & """"
        ThisWorkbook.VBProject.References.AddFromFile strDLLFilePath
    Else
        MsgBox "DLLFilePath: " & strDLLFilePath & " File Miss!"
    End If
    
    Set FSO = Nothing
End Function

in VBA, "TestUserForm" UserForm

Option Explicit
Private Sub UserForm_Initialize()
    MsgBox "UserForm_Initialized!"
    
    Dim clsRunControlsAdd As New VB6_VBA_Control.ControlsAddClass
    clsRunControlsAdd.VBAUserFormControlAdd objRunForm:=Me
End Sub

Answer 1

The biggest issue I faced in getting this to work was in wiring up events. After some research, I found how to accomplish this task. Here is the modified code:

Option Explicit

Public Function VBAUserFormControlAdd(objRunForm As MSForms.UserForm)
   Dim MyControls As Collection
   Dim c As Object
   Dim ce As CatchEvents
   
   Set MyControls = New Collection
   
   Set c = objRunForm.Controls.Add("Forms.CommandButton.1", "cmdbtnTest1", True)
   c.Top = 200
   c.Caption = "Button 1"
   Set ce = New CatchEvents
   ce.Item = c
   MyControls.Add ce

   Set c = objRunForm.Controls.Add("Forms.CommandButton.1", "cmdbtnTest2", True)
   c.Top = 300
   c.Caption = "Button 2"
   Set ce = New CatchEvents
   ce.Item = c
   MyControls.Add ce
End Function

The additional steps are to capture each created control as an Object, give that Object to the CatchEvents class, and then cache each CatchEvents class in a Collection.

The magic happens in CatchEvents, shown below for convenience, which is slightly modified from this excellent answer. You will need to create the class outside of the VB6 IDE by using a text editor. Name the file "CatchEvents.cls" and then add this file to your project. A detailed explanation of this class can be found in the linked answer.

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "CatchEvents"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False

Option Explicit

Private Type GUID
   Data1 As Long
   Data2 As Integer
   Data3 As Integer
   Data4(0 To 7) As Byte
End Type

Private Declare Function ConnectToConnectionPoint Lib "shlwapi" Alias "#168" (ByVal punk As stdole.IUnknown, ByRef riidEvent As GUID, _
   ByVal fConnect As Long, ByVal punkTarget As stdole.IUnknown, ByRef pdwCookie As Long, Optional ByVal ppcpOut As Long) As Long

Private EventGuide As GUID
Private Ck As Long
Private ctl As Object

Public Sub MyClick()
Attribute MyClick.VB_UserMemId = -600
   MsgBox ctl.Name & " Clicked"
End Sub

Public Sub ConnectAllEvents(ByVal Connect As Boolean)
   With EventGuide
      .Data1 = &H20400
      .Data4(0) = &HC0
      .Data4(7) = &H46
   End With
   
   ConnectToConnectionPoint Me, EventGuide, Connect, ctl, Ck, 0&
End Sub

Public Property Let Item(Ctrl As Object)
   Set ctl = Ctrl
   ConnectAllEvents True
End Property

Public Sub Clear()
   If Ck <> 0 Then ConnectAllEvents False
   Set ctl = Nothing
End Sub

I have only wired up the Click event through the MyClick method. You can add other events as needed. Here is the result after you compile the dll and hook it up to your Excel UserForm: