Option Compare Database
Option Explicit
'Предок сам создает потомка (нестандартный вариант)

Private FChild As Object 'Вероятный наследник (любого типа!!!!)

Private Sub Class_Terminate()
Set FChild = Nothing
Debug.Print "Уничтожили предка"
End Sub

Public Property Get mType() As String
If FChild Is Nothing Then
    mType = TypeName(Me)
Else
    mType = TypeName(FChild)
End If
End Property

Public Property Let mType(byType As String)
'Создать объект-потомок типа byType
If Not FChild Is Nothing Then Set FChild = Nothing
Set FChild = GetObjectByTypeName(byType)
If Not FChild Is Nothing Then Set FChild.Doc = Me
End Property

Private Function GetObjectByTypeName(byType As String) As Object
'Как образец
'Может быть внешней функцией
'Должна обеспечить, если сможет :) создание объекта-наследника конкретного типа
Select Case byType
    Case "mDocChild": Set GetObjectByTypeName = New mDocChild
    Case Else: Set GetObjectByTypeName = Nothing
End Select
End Function

Public Function OnlyParent() As String
'функция не перегруженная
OnlyParent = TypeName(Me)
End Function

Public Function OnlyParentOverload(Optional ext As Boolean = False) As String
'Функция перегружаемая потомком
'************************************************
'Параметр Optional ext As Boolean = False обязателен для перегружаемых методов
'ext необходим для предотвращения stack overflow при обратных вызовах
'Следующий код нужно тупо вставлять для всех перегружаемых методов
If ext Then GoTo selfCode
On Error GoTo selfCode
OnlyParentOverload = FChild.OnlyParentOverload
Exit Function
selfCode:
On Error GoTo 0
'************************************************
'Собственный код mDoc
OnlyParentOverload = "Из предка mDoc"
End Function

Option Compare Database
Option Explicit
'Потомок mDoc с наследованием и перегрузкой методов

Public Doc As mDoc 'экземпляр класса предка

Public Function OnlyParentOverload() As String
'Функция перегруженная потомком
OnlyParentOverload = "Из потомка mDocChild " _
& "+ " & Doc.OnlyParentOverload(True)
End Function

Private Sub Class_Terminate()
Debug.Print "Уничтожили потомка"
End Sub

Public Sub testOverLoad()
Dim Doc As mDoc
Set Doc = New mDoc
Doc.mType = "mDocChild"
Debug.Print Doc.OnlyParent & " не перегружаемая"
Debug.Print Doc.OnlyParentOverload & " перегруженная"
Doc.mType = ""
Set Doc = Nothing
End Sub