如何在Excel VBA中使用Implements

时间:2013-10-15 04:01:21

标签: excel vba excel-vba interface

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

我要做的是拥有一个名为cShape的界面,并cRectanglecCircle实施cShape

我的代码如下:

cShape界面

Option Explicit

Public Function getArea()
End Function

Public Function getInertiaX()
End Function

Public Function getInertiaY()
End Function

Public Function toString()
End Function

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

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

问题在于,无论何时运行我的测试用例,都会出现以下错误:

  

编译错误:

     

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

实现'〜'

6 个答案:

答案 0 :(得分:79)

这是一个深奥的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

将文件 ShapesCollection.cls 保存到桌面。

  

请确保使用 *.cls扩展程序保存,而不是ShapesCollection.cls.txt

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

enter image description here

  

注意:您需要先将代码保存在 .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

<强> 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

<强> 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

您现在需要 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

运行 Main Sub并查看 Immediate Window CTRL + G中的结果

enter image description here


评论和解释:

ShapesCollection类模块中,有2个子项用于向集合中添加项目。

第一个方法Public Sub Add(ByVal Item As Object)只需要一个类实例并将其添加到集合中。您可以在 Module1 中使用它

Dim c1 As New cCircle
shapes.Add c1

Public Sub AddShapes(ParamArray arr() As Variant)允许您添加多个对象,同时用,逗号分隔它们,其方式与AddShapes() Sub相同。

这是一个比单独添加每个对象更好的设计,但这取决于你要去哪一个。

注意我是如何在循环中注释掉一些代码的

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

如果您从'If'End If行删除评论,则只能打印cCircle个对象。如果你可以在VBA中使用委托,那么这将非常有用,但你不能这样,我已经向你展示了另一种只打印一种类型对象的方法。显然,您可以修改If语句以满足您的需要,或者只是打印出所有对象。同样,由您决定如何处理数据:)

答案 1 :(得分:14)

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

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

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

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

类IDrawable:

'IDrawable interface, defining what methods drawable objects have access to
Public Function draw()
End Function

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

类IShape:

'Get the area of a shape
Public Function getArea() As Double
End Function

我们遇到麻烦的部分是我们想要使每个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

接下来的部分是接口的典型用途/好处发挥作用。

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

模块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

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

Dim square          As cSquare

Set square = mFactory.createSquare(5, 5, 0, 0)

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

enter image description here

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

现在你应该想知道如果你真的想要创建一个可绘制对象的集合会发生什么。您的应用可能恰好包含不是形状但仍可绘制的对象。从理论上讲,没有什么可以阻止你有一个可以绘制的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

装饰器允许您添加本机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

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

但也许将对象声明为接口的最相关原因很重要,因为我们只想公开接口中定义的方法,而不是那些已定义的公共方法关于我们以前见过的各个班级。

Dim square_1        As IDrawable 

enter image description here

我们不仅确定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 

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

dim myList as ArrayList 'We don't want this

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

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

set myList = new ArrayList

到:

set myList = new LinkedList 

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

最后一件事(可能是VBA中鲜为人知的行为)是你可以给一个接口一个默认的实现

我们可以通过以下方式定义界面:

IDrawable:

Public Function draw()
    Debug.Print "Draw interface method"
End Function

以及实现draw方法的类:

cSquare:

implements IDrawable 
Public Function draw()
    Debug.Print "Draw square method" 
End Function

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

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    

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

答案 2 :(得分:11)

关于VBA和&#34; Implements&#34;有两个未记载的附加内容。言。

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

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

答案 3 :(得分: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

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

cShape Class

Option Explicit

Public Function getArea()
End Function

Public Function getInertiaX()
End Function

Public Function getIntertiaY()
End Function

Public Function toString()
End Function

enter image description here

答案 4 :(得分:3)

语法快速修复

如果界面ISomeInterface具有:

Public Sub someMethod()
    ' Interface, no code
End Sub

然后实现需要像:

Implements ISomeInterface

Public Sub ISomeInterface_someMethod()
    '      ^^^^^^^^^^^^^^^  ' If missing: Compile Error 
    ' Code goes here
End Sub

一个很好的方法:

Implements ISomeInterface

Private Sub someMethod()
    ' Business logic goes here
End Sub

Public Sub ISomeInterface_someMethod()
    someMethod ' i.e. Business logic in 1 place: someMethod
End Sub

那就是说,其他答案非常值得一读。

答案 5 :(得分:2)

非常有趣的帖子,了解为什么以及何时界面有用!但我认为你关于默认实现的最后一个例子是不正确的。第一次调用square_1的draw方法实例化为IDrawable正确打印您给出的结果,但第二次调用square_1作为cSquare实例化的draw方法不正确,没有打印任何内容。实际上有3种不同的方法可以发挥作用:

IDrawable.cls:

Public Function draw()
    Debug.Print "Interface Draw method"
End Function

cSquare.cls:

Implements IDrawable

Public Function draw()
    Debug.Print "Class Draw method"
End Function

Public Function IDrawable_draw()
    Debug.Print "Interfaced Draw method"
End Function

标准模块:

Sub Main()
    Dim square_1 As IDrawable
    Set square_1 = New IDrawable
    Debug.Print "square_1 : ";
    square_1.draw

    Dim square_2 As cSquare
    Set square_2 = New cSquare
    Debug.Print "square_2 : ";
    square_2.draw 

    Dim square_3 As IDrawable
    Set square_3 = New cSquare
    Debug.Print "square_3 : ";
    square_3.draw
End Sub

结果:

square_1 : Interface Draw method
square_2 : Class Draw method
square_3 : Interfaced Draw method