我正在使用接口(interface)来确保一些相似的类实现了一些必须的方法(subs/functions)。
例如:
C1和C2还需要完全相同的方法，例如方法SM1和SM2。
为了避免重复定义SM1和SM2，我想定义一个抽象类(AC):
然后由C1和C2继承该抽象类。
在Java中，这个解决方案是可行的，但我没有找到任何在VBA中实现相同功能的文档。(VB.Net似乎允许使用关键字MustInherit定义抽象类。)
请确认是否可以在VBA中实现该解决方案？
VBA 中没有继承。
你可以定义一个接口，并使用 Implements 关键字在类中实现该接口。但如果你想要基类提供共享功能的预实现，你必须使用复制粘贴方法。
相关阅读：
如何在 Excel VBA 中使用 Implements
如何在 VBA 中使用类对象模块之间的比较方法，类似于 VB.NET？
你可以在VBA中实现半装饰器模式 :-)
假设我们有一个基类和两个子类，在子类中使用Implements关键字可以确保子类具有与基类相同的接口，并同时在每个子类中声明一个私有实例化的基类，并将来自子类的调用重定向到基类。
注意：这里的基类是普通类，您仍然可以创建它的实例（因此它不是真正的抽象类）。
例如：
' Standard module
Sub main()
Dim a As New ChildA
Dim b As New ChildB
a.State = 2
b.State = 5
Debug.Print TypeOf a Is Base
Debug.Print TypeOf b Is Base
TestPolymorphic a
TestPolymorphic b
End Sub
Private Sub TestPolymorphic(ByRef obj As Base)
obj.Polymorphic
End Sub
' -----------------------------------------------
' Base class module
Private m_state As Byte
Public Event StateChanged(oldState As Byte, newState As Byte)
Public Property Get State() As Byte
State = m_state
End Property
Public Property Let State(ByVal newState As Byte)
Dim oldState As Byte
oldState = m_state
m_state = newState
RaiseEvent StateChanged(oldState, newState)
End Property
Sub Polymorphic()
Err.Raise 123, , "Implement in child class"
End Sub
Private Sub Class_Initialize()
m_state = 1
End Sub
' -----------------------------------------------
' ChildA class module
Implements Base
Private WithEvents m_base As Base
Private Sub Class_Initialize()
Set m_base = New Base
End Sub
Public Property Get State() As Byte
State = Base_State
End Property
Public Property Let State(ByVal newState As Byte)
Base_State = newState
End Property
Public Sub Polymorphic()
Base_Polymorphic
End Sub
Private Property Get Base_State() As Byte
Base_State = m_base.State
End Property
Private Property Let Base_State(ByVal newState As Byte)
m_base.State = newState
End Property
Private Sub Base_Polymorphic()
Debug.Print "In Child A ..."
End Sub
Private Sub m_base_StateChanged(oldState As Byte, newState As Byte)
Debug.Print "State of 'Child A' instance has changed from " & oldState & " to " & newState
End Sub
Output:
' State of 'Child A' instance has changed from 1 to 2
' State of 'Child B' instance has changed from 1 to 5
' True
' True
' In Child A ...
' In Child B ...
我在vba中的抽象类解决方案: 查看
'-------------------------
' Standard module
Sub Main()
Dim objC1 As C1
Dim objC2 As C2
Dim objCollection As New Collection
Set objC1 = New C1
Set objC2 = New C2
With objC1
.getInterface.M1 "Hello C1!"
temp1 = .getInterface.M2(objCollection)
.getSuperClass.SM1 "Hi C1!!!"
temp3 = .getSuperClass.SM2(objCollection)
End With
Debug.Print vbCrLf
With objC2
.getInterface.M1 "Hello C2!"
temp1 = .getInterface.M2(objCollection)
.getSuperClass.SM1 "Hi C2!!!"
temp3 = .getSuperClass.SM2(objCollection)
End With
End Sub
' -----------------------------------------------
' IAbstracat class module
Sub SM1(strString As String): End Sub
Function SM2(varItem As Variant) As String: End Function
' -----------------------------------------------
' Abstracat class module
Implements IAbstract
'Each class must implement these methods, in a particular way
Sub M1(strString As String): End Sub
Function M2(varItem As Variant) As String: End Function
'The sub classes will extend SM1 and SM2
Private Sub IAbstract_SM1(strString As String)
Debug.Print "Sub IAbstract_SM1: " & strString
End Sub
'The sub classes will extend SM1 and SM2
Private Function IAbstract_SM2(varItem As Variant) As String
Dim strMyString As String
strMyString = "Function IAbstract_SM2 => ObjPtr(varItem): " & ObjPtr(varItem)
Debug.Print strMyString
IAbstract_SM2 = strMyString
End Function
' -----------------------------------------------
' C1 class module
Implements Abstract
Private Type TC1
objConcretSuperClass As Abstract
objInterfaceSuperClass As IAbstract
objInterfaceSubClass As Abstract
End Type
Private this As TC1
'if you do not need to initialize anything, then this is it:
Private Sub Class_Initialize()
With this
'creating an instance of class' Abstract'
Set .objConcretSuperClass = New Abstract
'Referencing the' Abstract 'interface, where are the extended methods
Set .objInterfaceSuperClass = .objConcretSuperClass
'Creating a refence for the C1 interface, which is the class' Abstract'
'Here we have the particular implementations of M1 and M2
Set .objInterfaceSubClass = Me
End With
End Sub
'With this we can do:
' set objC1 = New C1
' objC1.getInterface.Abstract_M1
' objC1.getInterface.Abstract_M2
Property Get getInterface() As Abstract
Set getInterface = this.objInterfaceSubClass
End Property
'With this we can call the methods defined in' Abstract ': SM1 and SM2
' set objC1 = New C1
' objC1.getSuperClass.SM1 "hello!"
' temp = objC1.getSuperClass.SM2 (New Collection)
Property Get getSuperClass() As IAbstract
Set getSuperClass = this.objInterfaceSuperClass
End Property
'Here we have the particular implementations of M1 and M2
Private Sub Abstract_M1(strString As String)
Debug.Print "Class C1 => Sub Abstract_M1: " & strString
End Sub
Private Function Abstract_M2(varItem As Variant) As String
Debug.Print "Class C1 => Function Abstract_M2: " & ObjPtr(varItem)
End Function
' -----------------------------------------------
' C2 class module
Implements Abstract
Private Type TC2
objConcretSuperClass As Abstract
objInterfaceSuperClass As IAbstract
objInterfaceSubClass As Abstract
End Type
Private this As TC2
'if you do not need to initialize anything, then this is it:
Private Sub Class_Initialize()
With this
'creating an instance of class' Abstract'
Set .objConcretSuperClass = New Abstract
'Referencing the' Abstract 'interface, where are the extended methods
Set .objInterfaceSuperClass = .objConcretSuperClass
'Creating a refence for the C1 interface, which is the class' Abstract'
'Here we have the particular implementations of M1 and M2
Set .objInterfaceSubClass = Me
End With
End Sub
'With this we can do:
' set objC2 = New C2
' objC2.getInterface.Abstract_M1
' objC2.getInterface.Abstract_M2
Property Get getInterface() As Abstract
Set getInterface = this.objInterfaceSubClass
End Property
'With this we can call the methods defined in' Abstract ': SM1 and SM2
' set objC1 = New C1
' objC1.getSuperClass.SM1 "hello!"
' temp = objC1.getSuperClass.SM2 (New Collection)
Property Get getSuperClass() As IAbstract
Set getSuperClass = this.objInterfaceSuperClass
End Property
'Here we have the particular implementations of M1 and M2
Private Sub Abstract_M1(strString As String)
Debug.Print "Class C2 => Sub Abstract_M1: " & strString
End Sub
Private Function Abstract_M2(varItem As Variant) As String
Debug.Print "Class C2 => Function Abstract_M2: " & ObjPtr(varItem)
End Function
立即检查窗口（CTRL + G）：
Class C1 => Sub Abstract_M1: Hello C1!
Class C1 => Function Abstract_M2: 550324728
Sub IAbstract_SM1: Hi C1!!!
Function IAbstract_SM2 => ObjPtr(varItem): 550324728
Class C2 => Sub Abstract_M1: Hello C2!
Class C2 => Function Abstract_M2: 550324728
Sub IAbstract_SM1: Hi C2!!!
Function IAbstract_SM2 => ObjPtr(varItem): 550324728