如何在 Excel VBA 中使用工具 [英] How to use the Implements in Excel VBA

问题描述

我正在尝试为工程项目实现一些形状，并将其抽象为一些常用功能，以便我可以拥有一个通用程序.

我想做的是有一个名为 cShape 的接口，并让 cRectangle 和 cCircle 实现 cShape>

我的代码如下:

cShape 界面

选项显式公共函数 getArea()结束函数公共函数 getInertiaX()结束函数公共函数 getInertiaY()结束函数公共函数 toString()结束函数

cRectangle 类

选项显式实现 cShapePublic myLength As Double ''将把长度视为 dPublic myWidth As Double ''将宽度视为 b公共函数 getArea()getArea = myLength * myWidth结束函数公共函数 getInertiaX()getInertiaX = (myWidth) * (myLength ^ 3)结束函数公共函数 getInertiaY()getInertiaY = (myLength) * (myWidth ^ 3)结束函数公共函数 toString()toString = "这是一个 "&我的宽度和"由"&我的长度&"矩形."结束函数

cCircle 类

选项显式实现 cShape公开 myRadius 作为双倍公共函数 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 &"圈."结束函数

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

<块引用>

编译错误:

<块引用>

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

解决方案

这是一个深奥的 OOP 概念，您还需要做一些事情并了解使用自定义形状集合.

您可能首先想通过

Excel 的每日剂量:自定义集合班级

Excel论坛:VBA的属性语句类

PC 评论:VBA Excel集合

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

cShape 这是你的界面

公共函数 GetArea() As Double结束函数公共函数 GetInertiaX() As Double结束函数公共函数 GetInertiaY() As Double结束函数公共函数 ToString() 作为字符串结束函数

cCircle

选项显式实现 cShape公共半径翻倍公共函数 GetDiameter() As Double获取直径 = 2 * 半径结束函数公共函数 GetArea() As DoubleGetArea = Application.WorksheetFunction.Pi() * (半径 ^ 2)结束函数''绕X轴的惯性公共函数 GetInertiaX() As DoubleGetInertiaX = Application.WorksheetFunction.Pi()/4 * (半径 ^ 4)结束函数''绕Y轴的惯性''Ix = Iy 在一个圆圈中，技术上应该使用相同的功能公共函数 GetInertiaY() As DoubleGetInertiaY = Application.WorksheetFunction.Pi()/4 * (Radius ^ 4)结束函数公共函数 ToString() 作为字符串ToString = "这是一个半径 " &半径&"圆圈."结束函数'接口函数私有函数 cShape_getArea() As DoublecShape_getArea = GetArea结束函数私有函数 cShape_getInertiaX() As DoublecShape_getInertiaX = GetInertiaX结束函数私有函数 cShape_getInertiaY() As DoublecShape_getInertiaY = GetInertiaY结束函数私有函数 cShape_toString() 作为字符串cShape_toString = ToString结束函数

c矩形

选项显式实现 cShapePublic Length As Double ''将把长度视为 dPublic Width As Double ''将把宽度视为 b公共函数 GetArea() As Double获取面积 = 长度 * 宽度结束函数公共函数 GetInertiaX() As DoubleGetInertiaX =(宽度)*(长度 ^ 3)结束函数公共函数 GetInertiaY() As DoubleGetInertiaY = (长度) * (宽度^ 3)结束函数公共函数 ToString() 作为字符串ToString = "这是一个 " &宽度&由" &长度&"长方形."结束函数'接口属性私有函数 cShape_getArea() As DoublecShape_getArea = GetArea结束函数私有函数 cShape_getInertiaX() As DoublecShape_getInertiaX = GetInertiaX结束函数私有函数 cShape_getInertiaY() As DoublecShape_getInertiaY = GetInertiaY结束函数私有函数 cShape_toString() 作为字符串cShape_toString = ToString结束函数

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

模块 1

选项显式子主()暗淡的形状 As ShapesCollection设置形状 = 新形状集合添加形状到形状将 iShape 调暗为 cShape对于每个 iShape 形状'如果 iShape 的 TypeOf 是 cCircle 那么Debug.Print iShape.ToString, "Area:" &iShape.GetArea, "InertiaX:" &iShape.GetInertiaX, "InertiaY:" &iShape.GetInertiaY'万一下一个结束子私有子 AddShapesTo(ByRef 形状作为 ShapesCollection)Dim c1 作为新的 cCirclec1.半径 = 10.5Dim c2 As New cCirclec2.半径 = 78.265将 r1 调暗为新的 cRectangler1.Length = 80.87r1.Width = 20.6将 r2 调暗为新的 cRectangler2.Length = 12.14r2.Width = 40.74形状.AddShapes c1, c2, r1, r2结束子

运行 Main 子并在 Immediate Window CTRL 中查看结果kbd>+G

<小时>

评论和解释:

在您的 ShapesCollection 类模块中，有 2 个用于向集合添加项目的子项.

第一个方法 Public Sub Add(ByVal Item As Object) 只是获取一个类实例并将其添加到集合中.您可以像这样在 Module1 中使用它

Dim c1 As New cCircle形状.添加 c1

Public Sub AddShapes(ParamArray arr() As Variant) 允许您同时添加多个对象，以相同的方式用 , 逗号分隔它们正如 AddShapes() Sub 所做的那样.

与单独添加每个对象相比，这种设计要好得多，但您要选择哪个对象取决于您.

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

将 iShape 变暗为 cShape对于每个 iShape 形状'如果 iShape 的 TypeOf 是 cCircle 那么Debug.Print iShape.ToString, "Area:" &iShape.GetArea, "InertiaX:" &iShape.GetInertiaX, "InertiaY:" &iShape.GetInertiaY'万一下一个

如果您从 'If 和 'End If 行中删除注释，您将只能打印 cCircle 对象.如果您可以在 VBA 中使用委托，这将非常有用，但您不能，所以我向您展示了仅打印一种类型对象的另一种方式.您显然可以修改 If 语句以满足您的需要或简单地打印出所有对象.同样，这取决于您将如何处理您的数据:)

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:

• Chris Pearson: Default Member

• Daily Dose of Excel: Custom Collection Class

• Excel Forum: Attribute Statements of VBA Classes

• PC-Review: VBA Excel Collections

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屋！