如何在Excel VBA中使用Implements

Zig*_*igu 60 excel vba interface excel-vba

我正在尝试为工程项目实现一些形状并将其抽象出来以用于一些常见功能,以便我可以使用通用程序.

我正在尝试做的是有一个调用的接口,cShape并拥有cRectangle并cCircle实现cShape

我的代码如下:

cShape 接口

Option Explicit

Public Function getArea()
End Function

Public Function getInertiaX()
End Function

Public Function getInertiaY()
End Function

Public Function toString()
End Function
Run Code Online (Sandbox Code Playgroud)

cRectangle 类

Option Explicit
Implements cShape

Public myLength As Double ''going to treat length as d
Public myWidth As Double ''going to treat width as b

Public Function getArea()
    getArea = myLength * myWidth
End Function

Public Function getInertiaX()
    getInertiaX = (myWidth) * (myLength ^ 3)
End Function

Public Function getInertiaY()
    getInertiaY = (myLength) * (myWidth ^ 3)
End Function

Public Function toString()
    toString = "This is a " & myWidth & " by " & myLength & " rectangle."
End Function
Run Code Online (Sandbox Code Playgroud)

cCircle 类

Option Explicit
Implements cShape

Public myRadius As Double

Public Function getDiameter()
    getDiameter = 2 * myRadius
End Function

Public Function getArea()
    getArea = Application.WorksheetFunction.Pi() * (myRadius ^ 2)
End Function

''Inertia around the X axis
Public Function getInertiaX()
    getInertiaX = Application.WorksheetFunction.Pi() / 4 * (myRadius ^ 4)
End Function

''Inertia around the Y axis
''Ix = Iy in a circle, technically should use same function
Public Function getInertiaY()
    getInertiaY = Application.WorksheetFunction.Pi() / 4 * (myRadius ^ 4)
End Function

Public Function toString()
    toString = "This is a radius " & myRadius & " circle."
End Function
Run Code Online (Sandbox Code Playgroud)

问题是每当我运行我的测试用例时,它都会出现以下错误:

编译错误:

对象模块需要为接口'〜'实现'〜'

小智 85

这是一个深奥的OOP概念,你需要做更多的事情来理解使用自定义的形状集合.

您可能首先想要this answer了解VBA中的类和接口.


请按照以下说明操作

首先打开记事本并复制粘贴以下代码

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1
END
Attribute VB_Name = "ShapesCollection"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit

Dim myCustomCollection As Collection

Private Sub Class_Initialize()
    Set myCustomCollection = New Collection
End Sub

Public Sub Class_Terminate()
    Set myCustomCollection = Nothing
End Sub

Public Sub Add(ByVal Item As Object)
    myCustomCollection.Add Item
End Sub

Public Sub AddShapes(ParamArray arr() As Variant)
    Dim v As Variant
    For Each v In arr
        myCustomCollection.Add v
    Next
End Sub

Public Sub Remove(index As Variant)
    myCustomCollection.Remove (index)
End Sub

Public Property Get Item(index As Long) As cShape
    Set Item = myCustomCollection.Item(index)
End Property

Public Property Get Count() As Long
    Count = myCustomCollection.Count
End Property

Public Property Get NewEnum() As IUnknown
    Attribute NewEnum.VB_UserMemId = -4
    Attribute NewEnum.VB_MemberFlags = "40"
    Set NewEnum = myCustomCollection.[_NewEnum]
End Property
Run Code Online (Sandbox Code Playgroud)

将文件保存为ShapesCollection.cls您的桌面.

确保使用 扩展名保存它*.cls而不是ShapesCollection.cls.txt

现在打开Excel文件,转到VBE ALT+ F11并右键单击Project Explorer.选择Import File从下拉菜单和导航到该文件.

在此输入图像描述

注意:您需要.cls先将代码保存在文件中然后导入它,因为VBEditor不允许您使用属性.这些属性允许您在迭代中指定默认成员,并在自定义集合类上使用for each循环

看更多:

现在插入3个类模块.相应地重命名并复制粘贴代码

cShape 这是你的界面

Public Function GetArea() As Double
End Function

Public Function GetInertiaX() As Double
End Function

Public Function GetInertiaY() As Double
End Function

Public Function ToString() As String
End Function
Run Code Online (Sandbox Code Playgroud)

cCircle

Option Explicit

Implements cShape

Public Radius As Double

Public Function GetDiameter() As Double
    GetDiameter = 2 * Radius
End Function

Public Function GetArea() As Double
    GetArea = Application.WorksheetFunction.Pi() * (Radius ^ 2)
End Function

''Inertia around the X axis
Public Function GetInertiaX() As Double
    GetInertiaX = Application.WorksheetFunction.Pi() / 4 * (Radius ^ 4)
End Function

''Inertia around the Y axis
''Ix = Iy in a circle, technically should use same function
Public Function GetInertiaY() As Double
    GetInertiaY = Application.WorksheetFunction.Pi() / 4 * (Radius ^ 4)
End Function

Public Function ToString() As String
    ToString = "This is a radius " & Radius & " circle."
End Function

'interface functions
Private Function cShape_getArea() As Double
    cShape_getArea = GetArea
End Function

Private Function cShape_getInertiaX() As Double
    cShape_getInertiaX = GetInertiaX
End Function

Private Function cShape_getInertiaY() As Double
    cShape_getInertiaY = GetInertiaY
End Function

Private Function cShape_toString() As String
    cShape_toString = ToString
End Function
Run Code Online (Sandbox Code Playgroud)

因为CRectangle

Option Explicit

Implements cShape

Public Length As Double ''going to treat length as d
Public Width As Double ''going to treat width as b

Public Function GetArea() As Double
    GetArea = Length * Width
End Function

Public Function GetInertiaX() As Double
    GetInertiaX = (Width) * (Length ^ 3)
End Function

Public Function GetInertiaY() As Double
    GetInertiaY = (Length) * (Width ^ 3)
End Function

Public Function ToString() As String
    ToString = "This is a " & Width & " by " & Length & " rectangle."
End Function

' interface properties
Private Function cShape_getArea() As Double
    cShape_getArea = GetArea
End Function

Private Function cShape_getInertiaX() As Double
    cShape_getInertiaX = GetInertiaX
End Function

Private Function cShape_getInertiaY() As Double
    cShape_getInertiaY = GetInertiaY
End Function

Private Function cShape_toString() As String
    cShape_toString = ToString
End Function
Run Code Online (Sandbox Code Playgroud)

您现在需要Insert一个标准Module并复制粘贴下面的代码

模块1

Option Explicit

Sub Main()

    Dim shapes As ShapesCollection
    Set shapes = New ShapesCollection

    AddShapesTo shapes

    Dim iShape As cShape
    For Each iShape In shapes
        'If TypeOf iShape Is cCircle Then
            Debug.Print iShape.ToString, "Area: " & iShape.GetArea, "InertiaX: " & iShape.GetInertiaX, "InertiaY:" & iShape.GetInertiaY
        'End If
    Next

End Sub


Private Sub AddShapesTo(ByRef shapes As ShapesCollection)

    Dim c1 As New cCircle
    c1.Radius = 10.5

    Dim c2 As New cCircle
    c2.Radius = 78.265

    Dim r1 As New cRectangle
    r1.Length = 80.87
    r1.Width = 20.6

    Dim r2 As New cRectangle
    r2.Length = 12.14
    r2.Width = 40.74

    shapes.AddShapes c1, c2, r1, r2
End Sub
Run Code Online (Sandbox Code Playgroud)

运行MainSub并在+中查看结果Immediate Window CTRLG

在此输入图像描述


评论和解释:

In your ShapesCollection class module there are 2 subs for adding items to the collection.

The first method Public Sub Add(ByVal Item As Object) simply takes a class instance and adds it to the collection. You can use it in your Module1 like this

Dim c1 As New cCircle
shapes.Add c1
Run Code Online (Sandbox Code Playgroud)

The Public Sub AddShapes(ParamArray arr() As Variant) allows you to add multiple objects at the same time separating them by a , comma in the same exact way as the AddShapes() Sub does.

It's quite a better design than adding each object separately, but it's up to you which one you are going to go for.

Notice how I have commented out some code in the loop

Dim iShape As cShape
For Each iShape In shapes
    'If TypeOf iShape Is cCircle Then
        Debug.Print iShape.ToString, "Area: " & iShape.GetArea, "InertiaX: " & iShape.GetInertiaX, "InertiaY:" & iShape.GetInertiaY
    'End If
Next
Run Code Online (Sandbox Code Playgroud)

If you remove comments from the 'If and 'End If lines you will be able to print only the cCircle objects. This would be really useful if you could use delegates in VBA but you can't so I have shown you the other way to print only one type of objects. You can obviously modify the If statement to suit your needs or simply print out all objects. Again, it is up to you how you are going to handle your data :)

  • 哦,谢谢@Ioannis,这是一个简单的错误,我现在纠正了它.`IUnknown`是`stdole2.tlb`类型库的一部分.您可以使用[OLE/COM对象查看器](http://msdn.microsoft.com/en-us/library/windows/desktop/ms688269(v = vs.85).aspx)来发现实现.使用`IUnknown`进入更多细节可能也是一个新的独立问题:) (2认同)
  • 谢谢你的惊人详细解答!我正在尝试模拟一堆具有任意横截面形状的建筑柱.你的答案不仅回答了这个问题,而且是一个公平的块我的下一个问题任务(如何制作列的集合):)现在必须写一个最大或最小选择器! (2认同)
  • 我刚刚意识到@mehow是VBA4All ... d'oh. (2认同)
  • @mehow感谢你,我有几个问题.您是否有理由不在ShapesCollection类中使用Class_Initialize和Class_Terminate例程?而且,你是否有任何危险,你可以使索引参数Variant而不是Long,以便Key也可以传入Collection索引? (2认同)

Tra*_*ace 18

以下是给出答案的一些理论和实践贡献,以防人们到达这里,他们想知道什么是实现/接口.

我们知道,VBA不支持继承,因此我们几乎可以盲目地使用接口来实现不同类的公共属性/行为.
尽管如此,我认为描述两者之间的概念差异是有用的,以便了解它为何在以后发挥作用.

  • 继承:定义一个is-a关系(一个正方形是一个形状);
  • 接口:定义必须做的关系(典型的例子是drawable规定可绘制对象必须实现该方法的接口draw).这意味着源自不同根类的类可以实现常见行为.

继承意味着扩展了基类(某些物理或概念原型),而接口实现了一组定义某种行为的属性/方法.
因此,可以说这Shape是一个基类,所有其他形状都从该基类继承,可以实现drawable接口以使所有形状都可绘制.这个接口将是一个合同,保证每个Shape都有一个draw方法,指定应该如何/在哪里绘制一个形状:一个圆可以 - 或可能不 - 与方形不同.

class IDrawable:

'IDrawable interface, defining what methods drawable objects have access to
Public Function draw()
End Function
Run Code Online (Sandbox Code Playgroud)

由于VBA不支持继承,我们自动被迫选择创建一个接口IShape,它保证通用形状(方形,圆形等)实现某些属性/行为,而不是创建一个抽象的Shape基类,我们从可以扩展.

类IShape:

'Get the area of a shape
Public Function getArea() As Double
End Function
Run Code Online (Sandbox Code Playgroud)

我们遇到麻烦的部分是我们想要使每个Shape都可绘制的部分.
不幸的是,由于IShape是一个接口而不是VBA中的基类,我们无法在基类中实现drawable接口.似乎VBA不允许我们让一个接口实现另一个接口; 在测试完之后,编译器似乎没有提供所需的行为.换句话说,我们无法在IShape中实现IDrawable,并且期望IShape的实例因此而被迫实现IDrawable方法.
我们被迫将这个接口实现到实现IShape接口的每个通用形状类,幸运的是VBA允许实现多个接口.

class cSquare:

Option Explicit

Implements iShape
Implements IDrawable

Private pWidth          As Double
Private pHeight         As Double
Private pPositionX      As Double
Private pPositionY      As Double

Public Function iShape_getArea() As Double
    getArea = pWidth * pHeight
End Function

Public Function IDrawable_draw()
    debug.print "Draw square method"
End Function

'Getters and setters
Run Code Online (Sandbox Code Playgroud)

接下来的部分是界面的典型用途/好处发挥作用的地方.

让我们通过编写一个返回新方块的工厂来开始我们的代码.(这只是我们无法将参数直接发送到构造函数的解决方法):

模块mFactory:

Public Function createSquare(width, height, x, y) As cSquare

    Dim square As New cSquare

    square.width = width
    square.height = height
    square.positionX = x
    square.positionY = y

    Set createSquare = square

End Function
Run Code Online (Sandbox Code Playgroud)

我们的主要代码将使用工厂创建一个新的Square:

Dim square          As cSquare

Set square = mFactory.createSquare(5, 5, 0, 0)
Run Code Online (Sandbox Code Playgroud)

当您查看您可以使用的方法时,您会注意到您在逻辑上可以访问cSquare类中定义的所有方法:

在此输入图像描述

我们稍后会看到为什么这是相关的.

现在你应该想知道如果你真的想要创建一个可绘制对象的集合会发生什么.您的应用可能包含不是形状但仍可绘制的对象.从理论上讲,没有什么可以阻止你有一个可以绘制的IComputer接口(可能是一些剪贴画或其他).
您可能想要拥有可绘制对象集合的原因是因为您可能希望在应用程序生命周期中的某个点处循环渲染它们.

在这种情况下,我将编写一个包装集合的装饰器类(我们将看到原因).class collDrawables:

Option Explicit

Private pSize As Integer
Private pDrawables As Collection

'constructor
Public Sub class_initialize()
    Set pDrawables = New Collection
End Sub

'Adds a drawable to the collection
Public Sub add(cDrawable As IDrawable)
    pDrawables.add cDrawable

    'Increase collection size
    pSize = pSize + 1

End Sub
Run Code Online (Sandbox Code Playgroud)

装饰器允许您添加本机vba集合不提供的一些便利方法,但这里的实际要点是集合只接受可绘制的对象(实现IDrawable接口).如果我们尝试添加一个不可绘制的对象,则会抛出类型不匹配(只允许绘制对象!).

所以我们可能想要遍历一组可绘制对象来渲染它们.允许不可绘制的对象进入集合会导致错误.渲染循环可能如下所示:

选项明确

Public Sub app()

    Dim obj             As IDrawable
    Dim square_1        As IDrawable
    Dim square_2        As IDrawable
    Dim computer        As IDrawable
    Dim person          as cPerson 'Not drawable(!) 
    Dim collRender      As New collDrawables

    Set square_1 = mFactory.createSquare(5, 5, 0, 0)
    Set square_2 = mFactory.createSquare(10, 5, 0, 0)
    Set computer = mFactory.createComputer(20, 20)

    collRender.add square_1
    collRender.add square_2
    collRender.add computer

    'This is the loop, we are sure that all objects are drawable! 
    For Each obj In collRender.getDrawables
        obj.draw
    Next obj

End Sub
Run Code Online (Sandbox Code Playgroud)

请注意,上面的代码增加了很多透明度:我们将对象声明为IDrawable,这使得循环永远不会失败,因为draw方法可用于集合中的所有对象.
如果我们尝试将Person添加到集合中,如果此Person类未实现drawable接口,则会抛出类型不匹配.

但也许将对象声明为接口的最相关原因很重要,因为我们只想暴露接口中定义的方法,而不是像我们之前看到的那样在各个类上定义的那些公共方法. .

Dim square_1        As IDrawable 
Run Code Online (Sandbox Code Playgroud)

在此输入图像描述

我们不仅确定square_1有一个draw方法,而且还确保只有 IDrawable定义的方法才会被暴露.
对于一个正方形,这样做的好处可能不会立即明确,但让我们看一下Java集合框架中的一个类比,它更加清晰.

想象一下,您有一个通用接口IList,它定义了一组适用于不同类型列表的方法.每种类型的列表都是一个特定的类,它实现IList接口,定义自己的行为,并可能在顶部添加更多自己的方法.

我们将列表声明如下:

dim myList as IList 'Declare as the interface! 

set myList = new ArrayList 'Implements the interface of IList only, ArrayList allows random (index-based) access 
Run Code Online (Sandbox Code Playgroud)

在上面的代码中,将列表声明为IList可确保您不使用特定于ArrayList的方法,而只使用接口规定的方法.想象一下,您按如下方式声明了列表:

dim myList as ArrayList 'We don't want this
Run Code Online (Sandbox Code Playgroud)

您将可以访问ArrayList类中专门定义的公共方法.有时这可能是期望的,但通常我们只是想利用内部类行为,而不是由特定于类的公共方法定义.
如果我们在代码中多次使用这个ArrayList 50,那么好处就变得清晰了,突然我们发现我们最好使用LinkedList(它允许与这种类型的List相关的特定内部行为).

如果我们遵守了界面,我们可以改变这一行:

set myList = new ArrayList
Run Code Online (Sandbox Code Playgroud)

至:

set myList = new LinkedList 
Run Code Online (Sandbox Code Playgroud)

并且没有其他代码会破坏,因为接口确保合同得到满足,即.仅使用IList上定义的公共方法,因此不同类型的列表可以随时间交换.

最后一件事(可能在VBA中鲜为人知的行为)是您可以为接口提供默认实现

我们可以通过以下方式定义接口:

IDrawable:

Public Function draw()
    Debug.Print "Draw interface method"
End Function
Run Code Online (Sandbox Code Playgroud)

以及一个实现draw方法的类:

的CSquare:

implements IDrawable 
Public Function draw()
    Debug.Print "Draw square method" 
End Function
Run Code Online (Sandbox Code Playgroud)

我们可以通过以下方式在实现之间切换:

Dim square_1        As IDrawable

Set square_1 = New IDrawable
square_1.draw 'Draw interface method
Set square_1 = New cSquare
square_1.draw 'Draw square method    
Run Code Online (Sandbox Code Playgroud)

如果将变量声明为cSquare,则无法执行此操作.
当这可能有用时,我不能立即想到一个很好的例子,但如果你测试它在技术上是可行的.


Ale*_* F. 12

关于VBA和"Implements"语句有两个未记载的附加内容.

  1. VBA不支持派生类的继承接口的方法名称中的非核心字符"_".它不会使用cShape.get_area等方法编译代码(在Excel 2007下测试):VBA将为任何派生类输出上面的编译错误.

  2. 如果派生类没有实现在接口中命名的自己的方法,则VBA会成功编译代码,但该方法将通过派生类类型的变量无法实现.

  • 接口类中的函数声明不能​​包含下划线。这应该在文档中用大粗体字母表示。 (3认同)

San*_*osh 8

我们必须在使用它的类中实现所有接口方法.

cCircle Class

Option Explicit
Implements cShape

Public myRadius As Double

Public Function getDiameter()
    getDiameter = 2 * myRadius
End Function

Public Function getArea()
    getArea = Application.WorksheetFunction.Pi() * (myRadius ^ 2)
End Function

''Inertia around the X axis
Public Function getInertiaX()
    getInertiaX = Application.WorksheetFunction.Pi() / 4 * (myRadius ^ 4)
End Function

''Inertia around the Y axis
''Ix = Iy in a circle, technically should use same function
Public Function getIntertiaY()
    getIntertiaY = Application.WorksheetFunction.Pi() / 4 * (myRadius ^ 4)
End Function

Public Function toString()
    toString = "This is a radius " & myRadius & " circle."
End Function

Private Function cShape_getArea() As Variant

End Function

Private Function cShape_getInertiaX() As Variant

End Function

Private Function cShape_getIntertiaY() As Variant

End Function

Private Function cShape_toString() As Variant

End Function
Run Code Online (Sandbox Code Playgroud)

cRectangle类

Option Explicit
Implements cShape

Public myLength As Double ''going to treat length as d
Public myWidth As Double ''going to treat width as b
Private getIntertiaX As Double

Public Function getArea()
    getArea = myLength * myWidth
End Function

Public Function getInertiaX()
    getIntertiaX = (myWidth) * (myLength ^ 3)
End Function

Public Function getIntertiaY()
    getIntertiaY = (myLength) * (myWidth ^ 3)
End Function

Public Function toString()
    toString = "This is a " & myWidth & " by " & myLength & " rectangle."
End Function

Private Function cShape_getArea() As Variant

End Function

Private Function cShape_getInertiaX() As Variant

End Function

Private Function cShape_getIntertiaY() As Variant

End Function

Private Function cShape_toString() As Variant

End Function
Run Code Online (Sandbox Code Playgroud)

cShape类

Option Explicit

Public Function getArea()
End Function

Public Function getInertiaX()
End Function

Public Function getIntertiaY()
End Function

Public Function toString()
End Function
Run Code Online (Sandbox Code Playgroud)

在此输入图像描述