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 '~'
Comment use the Implements in Excel VBA
Re: Comment use the Implements in Excel VBA
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`**](https://stackoverflow.com/questions/19881863/vba-classes-interfaces-implements-and-adequate-comparison-methods/19908375#19908375) 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.
>
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:
- [Chris Pearson: Default
Member](http://www.cpearson.com/excel/DefaultMember.aspx)
-
[Daily Dose of Excel: Custom Collection
Class](http://dailydoseofexcel.com/archives/2010/07/04/custom-collection-class/)
-
[Excel Forum: Attribute Statements of VBA
Classes](http://www.excelforum.com/excel-programming-vba-macros/562915-solved-attribute-statements-of-vba-classes.html)
-
[PC-Review: VBA Excel
Collections](http://www.pcreview.co.uk/forums/collections-vba-excel-and-probably-other-ms-office-2003-applications-t2293368.html)
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
## 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 :)
You may first want to go through [**`this answer`**](https://stackoverflow.com/questions/19881863/vba-classes-interfaces-implements-and-adequate-comparison-methods/19908375#19908375) 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.
>
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:
- [Chris Pearson: Default
Member](http://www.cpearson.com/excel/DefaultMember.aspx)
-
[Daily Dose of Excel: Custom Collection
Class](http://dailydoseofexcel.com/archives/2010/07/04/custom-collection-class/)
-
[Excel Forum: Attribute Statements of VBA
Classes](http://www.excelforum.com/excel-programming-vba-macros/562915-solved-attribute-statements-of-vba-classes.html)
-
[PC-Review: VBA Excel
Collections](http://www.pcreview.co.uk/forums/collections-vba-excel-and-probably-other-ms-office-2003-applications-t2293368.html)
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
## 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 :)