如何通过VBA覆盖获得智能感知

Question

Example of what I'm trying to do

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

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

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

下面的图像显示了我正在为自己的课程实现的目标（即获得Things.和Things(i).的intellisense ...）：

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

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

What I have

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

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

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

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

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

我想添加一个索引(i)，即item:=index必须是可选的，所以我使参数可选。

虽然在使用Documents集合时我注意到，当打开括号(...时，item参数不被[方括号]括起来（据我所知，通常表示可选）。

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

---

这是类和模块：

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

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

事物，事物的集合

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

事物，cloThing

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

对象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

Intellisense需要Object以外的返回类型 - 你需要返回你的oThing类型。

有多种方法可以获得您想要的内容以及有关如何执行此操作的各种问题 - 即 - 您是否要隐藏cThings类中的内部Collection，或者您是否希望像在示例中那样公开它（ IMO似乎很糟糕）。

我只想回答你的直接问题：

如何获得bar.Things.count上的计数智能感知

答：你在bar上设置了返回类型。就这样了。它可能是你的cThings集合类型，或者它可能是你在cThings集合类型中的集合（IMO返回内部Collection对象是不好的）。

所以类型Foo需要一个返回Things的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上获取名称的intellisense

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

如果您想在bar.Things.Item(1).name上使用Intellisense for name并放弃默认属性的快捷语法，那么您只需将以下内容添加到cThings：

Property Get Item(index) As oThing
    Set Items = myInternalCollection.Item(index)
End Property

现在你将在bar.Things.Item(1).name上有智能感知。

但是，如果你真的想要bar.Things(1)工作，那么你需要这样做：

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

Property Get Item(index) As oThing
    Attribute Value.VB_UserMemId = 0
    Set Items = myInternalCollection.Item(index)
End Property

然后，将其导入。

现在，bar.Things(1)将转换为bar.Things.Item(1)，它将返回一个项目并以intellisense显示。

Answer 2

编辑：有可能我只是以错误的方式去做。 @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