web-dev-qa-db-fra.com

Comment utiliser les implémentations dans Excel VBA

J'essaie d'implémenter certaines formes pour un projet d'ingénierie et de les résumer pour certaines fonctions courantes afin de pouvoir avoir un programme généralisé.

Ce que j'essaie de faire, c'est d'avoir une interface appelée cShape et d'avoir cRectangle et cCircle implémenter cShape

Mon code est ci-dessous:

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 classe

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 classe

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

Le problème est que chaque fois que j'exécute mes cas de test, il se produit l'erreur suivante:

Erreur de compilation:

Le module objet doit implémenter '~' pour l'interface '~'

excelvbaexcel-vbainterface
59
Zigu

Il s'agit d'un concept ésotérique OOP et il y a un peu plus que vous devez faire et comprendre pour utiliser une collection personnalisée de formes.

Vous voudrez peut-être d'abord passer par this answer pour obtenir une compréhension générale des classes et des interfaces dans VBA.

Ouvrez d'abord le Bloc-notes et copiez-collez le code ci-dessous

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

Enregistrez le fichier sous ShapesCollection.cls sur votre bureau.

Assurez-vous de l'enregistrer avec l'extension*.cls Et non ShapesCollection.cls.txt

Maintenant ouvrez votre fichier Excel, allez sur VBE ALT+F11 et faites un clic droit dans le Project Explorer. Sélectionnez Import File dans le menu déroulant et accédez au fichier.

enter image description here

NB: Vous devez d'abord enregistrer le code dans un fichier .cls, puis l'importer car VBEditor ne vous permet pas d'utiliser les attributs. Les attributs vous permettent de spécifier le membre par défaut dans l'itération et d'utiliser le pour chaque boucle sur les classes de collection personnalisées

Voir plus:

Insérez maintenant 3 modules de classe. Renommez en conséquence et copiez-collez le code

cShape c'est votre 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

Vous devez Insert un standard Module maintenant et copier-coller le code ci-dessous

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

Exécutez le Main Sub et vérifiez les résultats dans le Immediate Window CTRL+G

enter image description here

Commentaires et explication:

Dans votre module de classe ShapesCollection, il y a 2 sous-marins pour ajouter des éléments à la collection.

La première méthode Public Sub Add(ByVal Item As Object) prend simplement une instance de classe et l'ajoute à la collection. Vous pouvez l'utiliser dans votre Module1 comme ceci

Dim c1 As New cCircle
shapes.Add c1

La fonction Public Sub AddShapes(ParamArray arr() As Variant) vous permet d'ajouter plusieurs objets en même temps en les séparant par une virgule , De la même manière que la sous-fonction AddShapes().

C'est un meilleur design que d'ajouter chaque objet séparément, mais c'est à vous de choisir celui que vous allez choisir.

Remarquez comment j'ai commenté du code dans la boucle

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

Si vous supprimez les commentaires des lignes 'If Et 'End If, Vous ne pourrez imprimer que les objets cCircle. Ce serait vraiment utile si vous pouviez utiliser des délégués dans VBA mais vous ne pouvez pas, donc je vous ai montré l'autre façon d'imprimer un seul type d'objets. Vous pouvez évidemment modifier l'instruction If pour l'adapter à vos besoins ou simplement imprimer tous les objets. Encore une fois, c'est à vous de décider comment vous allez gérer vos données :)

84
user2140173

Il existe deux ajouts non documentés sur VBA et l'instruction "Implements".

  1. VBA ne prend pas en charge le caractère de non-décompression "_" dans le nom d'une méthode d'une interface héritée d'une classe dérivée. F.e. il ne compilera pas de code avec une méthode telle que cShape.get_area (testé sous Excel 2007): VBA générera l'erreur de compilation ci-dessus pour toute classe dérivée.

  2. Si une classe dérivée n'implémente pas la propre méthode nommée comme dans l'interface, VBA compile un code avec succès, mais la méthode sera inaccessible via une variable du type de classe dérivée.

12
Aleksey F.

Nous devons implémenter toutes les méthodes d'interface dans la classe qui est utilisée.

classe de cercle

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

Classe Rectangle

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

classe cSharp

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

8
Santosh

Correction rapide de la syntaxe

Si l'interface ISomeInterface a:

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

Alors le implémentation doit être comme:

Implements ISomeInterface

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

Une belle approche:

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

Cela dit, les autres réponses méritent d'être lues.

3
SlowLearner

Article très intéressant pour comprendre simplement pourquoi et quand une interface peut être utile! Mais je pense que votre dernier exemple sur l'implémentation par défaut est incorrect. Le premier appel à la méthode draw de square_1 instancié comme IDrawable imprime correctement le résultat que vous donnez, mais le deuxième appel à la méthode draw de square_1 instancié comme cSquare est incorrect, rien n'est imprimé. 3 méthodes différentes entrent en jeu:

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

Module standard:

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

Résulte en:

square_1 : Interface Draw method
square_2 : Class Draw method
square_3 : Interfaced Draw method
2
hymced