How to use the Implements in Excel VBA

2019-01-01 03:03发布

I'm trying to implement some shapes for an engineering project and abstract it out for some common functions so that I can have a generalized program.

What I'm trying to do is have an interface called cShape and have cRectangle and cCircle implement cShape

My code is below:

cShape interface

Option Explicit

Public Function getArea()
End Function

Public Function getInertiaX()
End Function

Public Function getInertiaY()
End Function

Public Function toString()
End Function

cRectangle class

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 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 getInertiaY()
    getInertiaY = Application.WorksheetFunction.Pi() / 4 * (myRadius ^ 4)
End Function

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

The problem is that whenever I run my test cases, it comes up with the following error:

Compile Error:

Object module needs to implement '~' for interface '~'

6条回答
弹指情弦暗扣
2楼-- · 2019-01-01 03:37

Quick Fix of Syntax

If the interface ISomeInterface has:

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

Then the implementation needs to be like:

Implements ISomeInterface

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

A nice approach:

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

That said, the other answers are very much worth reading.

查看更多
人间绝色
3楼-- · 2019-01-01 03:40

There are two undocumented additions about VBA and "Implements" statement.

  1. VBA does not support undescore character '_' in a method name of an inherited interface of a derived class. F.e. it will not compile a code with method such as cShape.get_area (tested under Excel 2007): VBA will output the compile error above for any derived class.

  2. If a derived class does not implement the own method named as in the interface, VBA compiles a code successfully, but the method will be inacessiable through a variable of the derived class type.

查看更多
听够珍惜
4楼-- · 2019-01-01 03:45

This is an esoteric OOP concept and there's a little more you need to do and understand to use a custom collection of shapes.

You may first want to go through this answer to get a general understanding of classes and interfaces in VBA.


Follow the below instructions

First open Notepad and copy-paste the below code

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

Save the file as ShapesCollection.cls to your desktop.

Make sure you are saving it with the *.cls extension and not ShapesCollection.cls.txt

Now open you Excel file, go to VBE ALT+F11 and right click in the Project Explorer. Select Import File from the drop-down menu and navigate to the file.

enter image description here

NB: You needed to save the code in a .cls file first and then import it because VBEditor does not allow you to use Attributes. The attributes allow you to specify the default member in the iteration and use the for each loop on custom collection classes

See more:

Now Insert 3 class modules. Rename accordingly and copy-paste the code

cShape this is your Interface

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

You need to Insert a standard Module now and copy-paste the below code

Module1

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 the Main Sub and check out the results in the Immediate Window CTRL+G

enter image description here


Comments and explanation:

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

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

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 :)

查看更多
公子世无双
5楼-- · 2019-01-01 03:45

We must implement all methods of interface in the class which it is used.

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 Class

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

查看更多
不再属于我。
6楼-- · 2019-01-01 03:47

Here are some theoretical and practical contributions to the answers given, in case people arrive here who wonder what implements / interfaces are about.

As we know, VBA doesn't support inheritance, hence we might almost blindly use interfaces to implement common properties/behaviour across different classes.
Still, I think that it is useful to describe what the conceptual difference is between the two to see why it matters later on.

  • Inheritance: defines an is-a relationship (a square is-a shape);
  • Interfaces: define a must-do relationship (a typical example is the drawable interface that prescribes that drawable object must implement the method draw). This means that classes originating from different root classes can implement common behaviour.

Inheritance means that a baseclass (some physical or conceptual archetype) is extended, whereas interfaces implement a set of properties/methods that define a certain behaviour.
As such, one would say that Shape is a base class from which all other shapes inherit, one that may implement the drawable interface to make all shapes drawable. This interface would be a contract that guarantees that every Shape has a draw method, specifying how/where a shape should be drawn: a circle may - or may not - be drawn differently from a square.

class IDrawable:

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

Since VBA doesn't support inheritance, we are automatically forced to opt for creating an interface IShape that guarantees certain properties/behaviour to be implemented by the generic shapes (square, circle, etc), rather than creating an abstract Shape baseclass from which we can extend.

class IShape:

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

The part where we get in trouble is when we want to make every Shape drawable.
Unfortunately, since IShape is an interface and not a base class in VBA, we cannot implement the drawable interface in the base class. It appears that VBA does not allow us to have one interface implement another; after having tested this, the compiler doesn't seem to provide the desired behaviour. In other words, we cannot implement IDrawable within IShape, and expect instances of IShape to be forced to implement IDrawable methods because of this.
We are forced to implement this interface to every generic shape class that implements the IShape interface, and luckily VBA allows multiple interfaces to be implemented.

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

The part that follows now is where the typical use / benefits of an interface come into play.

Let's start off our code by writing a factory that returns a new square. (This is just a workaround for our inability to send arguments directly to the constructor):

module 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

Our main code will use the factory to create a new Square:

Dim square          As cSquare

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

When you look at the methods that you have at your disposal, you'll notice that you logically get access to all the methods that are defined on the cSquare class:

enter image description here

We'll see later on why this is relevant.

Now you should wonder what will happen if you really want to create a collection of drawable objects. Your app could happen to contain objects that aren't shapes, but that are yet drawable. Theoretically, nothing prevents you from having an IComputer interface that can be drawn (may be some clipart or whatever).
The reason why you might want to have a collection of drawable objects, is because you may want to render them in a loop at a certain point in the app lifecycle.

In this case I will write a decorator class that wraps a collection (we'll see why). 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

The decorator allows you to add some convenience methods that native vba collections don't provide, but the actual point here is that the collection will only accept objects that are drawable (implement the IDrawable interface). If we would try to add an object that is not drawable, a type mismatch would be thrown (only drawable objects allowed!).

So we might want to loop over a collection of drawable objects to render them. Allowing a non-drawable object into the collection would result in a bug. A render loop could look like this:

Option Explicit

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

Note that the above code adds a lot of transparency: we declared the objects as IDrawable, which makes it transparent that the loop will never fail, since the draw method is available on all objects within the collection.
If we would try to add a Person to the collection, it would throw a type mismatch if this Person class did not implement the drawable interface.

But perhaps the most relevant reason why declaring an object as an interface is important, is because we only want to expose the methods that were defined in the interface, and not those public methods that were defined on the individual classes as we've seen before.

Dim square_1        As IDrawable 

enter image description here

Not only are we certain that square_1 has a draw method, but it also ensure that only methods defined by IDrawable get exposed.
For a square, the benefit of this might not be immediately clear, but let's have a look at an analogy from the Java collections framework that is much clearer.

Imagine that you have a generic interface called IList that defines a set of methods applicable on different types of lists. Each type of list is a specific class that implements the IList interface, defining their own behaviour, and possibly adding more methods of their own on top.

We declare the list as follows:

dim myList as IList 'Declare as the interface! 

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

In the above code, declaring the list as IList ensures that you won't use ArrayList-specific methods, but only methods that are prescribed by the interface. Imagine that you declared the list as follows:

dim myList as ArrayList 'We don't want this

You will have access to the public methods that are specifically defined on the ArrayList class. Sometimes this might be desired, but often we just want to take benefit of the internal class behaviour, and not defined by the class specific public methods.
The benefit becomes clear if we use this ArrayList 50 more times in our code, and suddenly we find out that we're better off using a LinkedList (which allows specific internal behaviour related to this type of List).

If we complied to the interface, we can change the line:

set myList = new ArrayList

to:

set myList = new LinkedList 

and none of the other code will break as the interface makes sure that the contract is fulfilled, ie. only public methods defined on IList are used, so the different types of lists are swappable over time.

A final thing (perhaps lesser known behaviour in VBA) is that you can give an interface a default implementation

We can define an interface in the following way:

IDrawable:

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

and a class that implements the draw method as well:

cSquare:

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

We can switch between the implementations the following way:

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    

This is not possible if you declare the variable as cSquare.
I can't immediately think of a good example when this might be useful, but it is technically possible if you test it.

查看更多
呛了眼睛熬了心
7楼-- · 2019-01-01 03:49

Very interesting post to understand simply why and when an interface can be useful! But I think your final example about the default implementation is incorrect. The first call to the draw method of square_1 instantiated as IDrawable correctly prints the result you give, but the second call to the draw method of square_1 instantiated as cSquare is incorrect, nothing is printed. 3 different methods actually come into play:

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

Standard module:

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

Results in:

square_1 : Interface Draw method
square_2 : Class Draw method
square_3 : Interfaced Draw method
查看更多
登录 后发表回答