excel - 如何使用 Excel VBA 中的工具

Question

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

我想做的是有一个名为cShape的接口(interface)，并让cRectangle和cCircle实现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

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

Compile Error:

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

Answer 1

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

您可能首先要浏览this answer对 VBA 中的类和接口(interface)有一个总体的了解。

<小时/>请按照以下说明进行操作

首先打开记事本并复制粘贴以下代码

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 到桌面。

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

现在打开 Excel 文件，转到 VBE ALT+F11 并右键单击项目资源管理器 。从下拉菜单中选择导入文件并导航到该文件。

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

查看更多:

• Chris Pearson: DefaultMember

• Daily Dose of Excel: Custom CollectionClass

• Excel Forum: Attribute Statements of VBAClasses

• PC-Review: VBA ExcelCollections

现在插入 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

c矩形

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

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

模块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子程序并在立即窗口中查看结果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 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 中使用委托(delegate)但您不能，那么这将非常有用，所以我向您展示了仅打印一种类型的对象的另一种方法。显然，您可以修改 If 语句以满足您的需要，或者简单地打印出所有对象。同样，这取决于您如何处理数据:)