如何使用Excel VBA中的实现 [英] How to use the Implements in Excel VBA

问题描述

我正在尝试为工程项目实现一些形状，并将其抽出出来用于一些常见的功能。尝试做的是有一个名为 cShape 的界面，并有 cRectangle 和 cCircle 实现 cShape

我的代码如下：

cShape 界面

 选项显式
 
公共函数getArea（）
结束函数
 
公共函数getInertiaX（）
结束函数
 
公共函数getInertiaY（）
结束函数
 
公共函数toString（）
结束函数
  

cRectangle class

  Option Explicit 
实现cShape 
 
 public myLength As Double将长度视为d 
 public myWidth As Double将宽度视为b 
 
酒吧public function getAnertiaX（）
 getInertiaX =（myWidth）*（myLength ^ 3）
结束函数
 
公共函数getInertiaY（）
 getInertiaY =（myLength）*（myWidth ^ 3）
结束函数
 
公共函数toString（ ）
 toString =这是一个& myWidth& by& myLength&  长方形。 
结束功能
  

cCircle class

  Option Explicit 
实现cShape 
 
 Public myRadius As Double 
 
公共函数getDiameter（）
 getDiameter = 2 * myRadius 
结束函数
 
公共函数getArea（）
 getArea = Application。 WorksheetFunction.Pi（）*（myRadius ^ 2）
结束函数
 
绕X轴的惯性
公共函数getInertiaX（）
 getInertiaX = Application.WorksheetFunction .Pi（）/ 4 *（myRadius ^ 4）
结束函数
 
'绕Y轴的惯性
''Ix = Iy在一个圆圈，技术上应该使用相同函数
公共函数getInertiaY（）
 getInertiaY = Application.WorksheetFunction.Pi（）/ 4 *（myRadius ^ 4）
结束函数
 
公共函数toString（） 
 toString =这是半径& myRadius& 圈。 
结束函数
  

问题是，每当我运行我的测试用例，它会出现以下错误：

编译错误：

对象模块需要实现' 〜'for interface'〜'

解决方案

这是一个深奥的OOP概念，有一点您需要做的更多的事情和理解来使用自定义的形状集合。

您可能想要经历， 2 ， 3 ， 4

现在插入3个类模块。重命名并复制代码

cShape 这是您的界面

 公共函数GetArea（）As Double 
结束函数
 
公共函数GetInertiaX（）As Double 
结束函数
 
公共函数GetInertiaY（）As Double 
结束函数
 
公共函数ToString（）As String 
结束函数
  

cCircle

  Option Explicit 
 
实现cShape 
 
公共半径As Double 
 
公共函数GetDiameter（）As Double 
 GetDiameter = 2 * Radius 
结束函数
 
公共函数GetArea（）As Double 
 GetArea = Application.WorksheetFunction.Pi（）*（Radius ^ 2）
结束函数
 
在X轴周围的惯性
公共函数GetInertiaX（）As Double 
 GetInertiaX = Application.WorksheetFunction.Pi（）/ 4 *（Radius ^ 4）
结束函数
 
在Y轴上的惯性
Ix = Iy在一个圆圈，技术上应该使用相同的功能
公共函数GetInertiaY（）As Double 
 GetInertiaY = Application.WorksheetFunction.Pi（）/ 4 *（Radius ^ 4）
结束函数
 
公共函数ToString（）As String 
 ToString =这是一个半径&半径& 圈。 
结束函数
 
'接口函数
私有函数cShape_getArea（）As Double 
 cShape_getArea = GetArea 
结束函数
 
私有函数cShape_getInertiaX（）As Double 
 cShape_getInertiaX = GetInertiaX 
结束函数
 
私有函数cShape_getInertiaY（）As Double 
 cShape_getInertiaY = GetInertiaY 
结束函数
 
私有函数cShape_toString（）As String 
 cShape_toString = ToString 
结束函数
  

cRectangle

  Option Explicit 
 
实现cShape 
 
公开长度为双倍'将长度视为d 
公共宽度为双倍'将宽度作为b 
 
公共功能GetArea（）As Double 
 GetArea =长度*宽度
结束函数
 
公共函数GetInertiaX（）As Double 
 GetInertiaX =（Width）*（Length ^ 3）
结束函数
 
公共功能离开GetInertiaY（）As Double 
 GetInertiaY =（Length）*（Width ^ 3）
结束函数
 
公共函数ToString（）As String 
 ToString =This是&宽度& by&长度&  长方形。 
结束函数
 
'接口属性
私有函数cShape_getArea（）As Double 
 cShape_getArea = GetArea 
结束函数
 
私有函数cShape_getInertiaX（）As Double 
 cShape_getInertiaX = GetInertiaX 
结束函数
 
私有函数cShape_getInertiaY（）As Double 
 cShape_getInertiaY = GetInertiaY 
结束函数
 
私有函数cShape_toString（）As String 
 cShape_toString = ToString 
结束函数
  

您需要 插入 标准 模块 现在并复制粘贴以下代码

Module1

  Option Explicit 
 
 Sub Main（）
 
 Dim shapes As ShapesCollection 
 Set shapes = New ShapesCollection 
 
 AddShapesTo形状
 
 Dim iShape As cShape 
对于每个iShape在形状
'如果TypeOf iShape是cCircle Th en 
 Debug.Print iShape.ToString，Area：& iShape.GetArea，InertiaX：& iShape.GetInertiaX，惯性：& iShape.GetInertiaY 
'End If 
 Next 
 
 End Sub 
 
 
私有子AddShapesTo（ByRef形状为ShapesCollection）
 
 Dim c1 As New cCircle 
 c1.Radius = 10.5 
 
 Dim c2 As New cCircle 
 c2.Radius = 78.265 
 
 Dim r1作为新的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，并查看 立即窗口 CTRL + G

---

评论与解释：

在您的 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在形状
'如果TypeOf iShape是cCircle然后
调试。打印iShape.ToString，区域：& iShape.GetArea，InertiaX：& iShape.GetInertiaX，惯性：& iShape.GetInertiaY 
'End If 
 Next 
  

如果您从'如果和'End If lines，您将只能打印 cCircle 对象。如果您可以在VBA中使用代理，那么这将非常有用，但是我不能以其他方式显示只打印一种类型的对象。您可以明显地修改如果语句，以满足您的需要或简单地打印所有对象。再次，由你决定如何处理你的数据：）

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 '~'

解决方案

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.

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: 1, 2, 3, 4

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

这篇关于如何使用Excel VBA中的实现的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！