如何使用VBA覆盖

Question

我正在尝试做的例子

在MS Office中，可以获得以下两者的智能感知：Application.Documents(1).和Application.Documents.

我正在尝试为自己的课程做同样的事情，我认为这被称为重写？

我陷入了智能感知......

以下图片展示了我正在为自己的课程实现的目标（即获得Things.和Things(i).的智能感知......）：

图片1 （下方）显示文档集合的智能感知，例如.count财产。

图片2 （下图）显示文档的智能感知，它完全不同。

我拥有什么

我开始修改此答案中的代码（提供基本结构的“计算器”）：https://stackoverflow.com/a/38704040/3451115

修改后的代码有2个新类，它们是'要返回的对象'（而不是原始代码中的计算值）：

• 集合类（cThings）
• 一个对象类（oThing）

所以，就像.Documents一样，我希望能够：

Things.或Things(i).并获取intellisense ...

我认为添加索引(i) 即。 item:=index 必须是可选的，所以我将参数设为可选的。

虽然在处理Documents集合时我注意到，在打开括号(...时，item参数未被[方括号] 括起来（据我所知，通常表示可选）< / em>的

问题：有可能吗？如何实现？

以下是课程＆amp;模块：

用于测试的标准模块（有效，但没有智能感知）：

Attribute VB_Name = "overrideExample"
Sub test()
    Dim bar As IFoo

    Set bar = New cFoo
    Debug.Print bar.Things.count     ' No intellisense for count

    Set bar = New oFoo
    Debug.Print bar.Things(1).name   ' No intellisense for name

End Sub

接口，IFoo

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
END
Attribute VB_Name = "IFoo"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit

Function Things(Optional index As Integer) As Object
End Function

Foo，cFoo

的集合

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
END
Attribute VB_Name = "cFoo"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit

Implements IFoo

Private mFunctions As Foo

Private Sub Class_Initialize()
    Set mFunctions = New Foo
End Sub

Private Sub Class_Terminate()
    Set mFunctions = Nothing
End Sub

Private Function IFoo_Things(Optional x As Integer) As Object
    Set IFoo_Things = mFunctions.Things ' Uses the standard aFunction
End Function

Foo的对象，oFoo

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
END
Attribute VB_Name = "oFoo"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit

Implements IFoo

Private mFunctions As Foo

Private Sub Class_Initialize()
    Set mFunctions = New Foo
End Sub

Private Sub Class_Terminate()
    Set mFunctions = Nothing
End Sub

Private Function IFoo_Things(Optional x As Integer) As Object
    Dim tempThing As oThing
    Set tempThing = New oThing
    tempThing.name = "FooBar"
    Set IFoo_Things = tempThing
End Function

收集物品，cThings

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
END
Attribute VB_Name = "cThings"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit

Private Type TThings
    m_objmyThings As Collection
End Type

Private this As TThings

Public Function count() As Integer
    count = this.m_objmyThings.count
End Function

Public Property Get myThings() As Collection
    Set myThings = this.m_objmyThings
End Property

Public Property Set myThings(ByVal objNewValue As Collection)
    Set this.m_objmyThings = objNewValue
End Property

Private Sub Class_Initialize()
Set this.m_objmyThings = New Collection
End Sub

事物的对象

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
END
Attribute VB_Name = "oThing"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit

Private Type TThing
    m_sName As String
End Type

Private this As TThing

Public Property Get name() As String
    name = this.m_sName
End Property

Public Property Let name(ByVal sNewValue As String)
    this.m_sName = sNewValue
End Property

Object Foo，Foo

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
END
Attribute VB_Name = "Foo"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit

Function Things(Optional x As Integer) As cThings
    Set Things = New cThings
End Function

Answer 1

编辑： 可能 我只是错误的方式。 @andrew提供了一种设置方式，按照问题中的图像完全按照我想要的方式工作。然而，这个（不正确的）答案为可能也在努力解决这个问题的其他人提供了一些有用的背景信息和背景......

我认为不可能（参见接受的答案）

在这里阅读：https://hammondmason.wordpress.com/2015/06/23/object-oriented-vba-overloading/声明VBA是一种动态类型语言，为了正确支持重载，需要静态输入，即强制执行更明确的变量类型。

并且，如@TimWilliams所述 - 返回一个对象基本上会阻止智能感知......

那就是说，我认为我改进了（简化）重载示例（但仍然没有intellisense）：

Sub test()

    Dim bar As IFoo

    Set bar = New cFoo
    Debug.Print bar.things.Count
    Debug.Print bar.things(1).name
    Set bar = Nothing

End Sub

修订cFoo：

Public Property Get things(Optional x As Integer) As Object
        Set things = IFoo_Things
End Property

Private Function IFoo_Things(Optional x As Integer = -1) As Object
    Select Case x

        Case -1 ' Return Collection of Things
            Set IFoo_Things = mFunctions.things

        Case Else ' Return specific Thing
            Dim tempThing As oThing
            Set tempThing = New oThing
            tempThing.name = "FooBar"
            Set IFoo_Things = tempThing
    End Select
End Function

Answer 2

智能感知需要Object以外的返回类型 - 您需要返回oThing类型。

有多种方法可以获得您想要的内容以及有关如何执行此操作的各种问题 - 即 - 您是否要隐藏cThings类中的内部集合，或者您是否希望将其公开你在你的例子中做了（IMO看起来很糟糕）。

我只会回答您的直接问题：

  

如何在bar.Things.count

上获得智能感知功能

答案：你在bar上设置了返回类型。它可能是您的cThings集合类型，也可能是cThings集合类型中的集合（IMO返回内部Collection对象很糟糕）。

因此类型Foo需要一个返回Things的{​​{1}}属性：

cThings

此外，Property Get Things() As cThings Set Things = myThings End Property 需要cThings属性。您可以直接传递内部集合的Count属性：

Count

  

如何在Property Get Count() As Long Count = myInternalCollection.Count End Property

上获取名称的智能感知功能

答案：首先，bar.Things(1).name的MSWord示例等同于Documents(i)，其中Documents.Item(i)是Item的默认属性，它采用索引。创建默认属性是VBA的难点。您必须将模块编辑为文本文件并导入它。吸。

如果你想在Documents上使用名称进行智能感知并放弃默认属性的快捷语法，那么你只需将以下内容添加到bar.Things.Item(1).name：

cThings

现在你将在Property Get Item(index) As oThing Set Items = myInternalCollection.Item(index) End Property 上进行智能感知。

但是，如果您真的希望bar.Things.Item(1).name能够工作，那么您需要这样做：

导出模块并将属性插入Item属性：

bar.Things(1)

然后，将其导回。

现在，Property Get Item(index) As oThing Attribute Value.VB_UserMemId = 0 Set Items = myInternalCollection.Item(index) End Property 将转换为bar.Things(1)，它将返回一个项目并以智能感知方式显示。