VBA 强制转换变体列表框/对象

Question

我在将变体"强制转换"到定义的对象时遇到了问题。

在运行时，我的变量类型为"Variant/Object/Listbox"，然后我想将其设置为ListBox变量，以将其作为参数路由到另一个需要Listbox对象的函数(GetSelected(。

但是我收到错误 13：命令"设置 lst = v"上的类型不兼容。

任何想法如何让它工作？

法典：

Function GetEditableControlsValues(EditableControls As Collection) As Collection
'Gibt die Werte der editierbaren Felder zurück.
Dim v As Variant
Dim coll As New Collection
Dim lst As ListBox
For Each v In EditableControls
If TypeName(v) = "ListBox" Then
Set lst = v     'Fehler 13: Typen unverträglich. v zur Laufzeit: Variant/Object/Listbox.
coll.Add GetCollectionString(GetSelected(lst))
Else
coll.Add v.Value
End If
Next
End Function

Answer 1

这是我到目前为止所拥有的：

假设您有一个包含以下代码的模块：

Option Explicit
Public Sub TestMe()
Dim colInput        As New Collection
Dim colResult       As Collection
Dim lngCount        As Long
Dim ufMyUf          As UserForm
Set ufMyUf = UserForm1
Set colInput = GetListBoxObjects(ufMyUf)
For lngCount = 1 To colInput.Count
Debug.Print colInput(lngCount).Name
Next lngCount
End Sub
Function GetListBoxObjects(uf As UserForm) As Collection
Dim colResult   As New Collection
Dim objObj      As Object
Dim ctrCont     As Control
For Each ctrCont In uf.Controls
If LCase(Left(ctrCont.Name, 7)) = "listbox" Then
Set objObj = ctrCont
colResult.Add objObj
End If
Next ctrCont
Set GetListBoxObjects = colResult
End Function

如果运行TestMe，则会得到ListBox对象的集合。无论如何，我不确定如何将它们传递给收集函数，因此我决定迭代 UserForm，从而检查其上的所有对象。

干杯！

Answer 2

我自己在转换控件时遇到了问题，并且没有找到可以轻松使用的通用解决方案。

最终我找到了做到这一点的方法：存储为"对象"可以轻松转换为控件的实际类型。

我测试(并使用(了它

下面的子显示它有效(这里：1个文本框;1个列表框;1个组合框;工作表上的1个命令按钮(

Sub Test_Casting()
Dim lis As MSForms.ListBox
Dim txt As MSForms.TextBox
Dim btn As MSForms.CommandButton
Dim com As MSForms.ComboBox
Dim numObjects As Integer: numObjects = Me.OLEObjects.Count
Dim obj() As Object
ReDim obj(1 To numObjects) As Object
Dim i As Integer: i = 0
Dim cttl As OLEObject
For Each ctrl In Me.OLEObjects
i = i + 1
Set obj(i) = ctrl.Object
Next ctrl
Dim result As String
For i = 1 To numObjects
If TypeOf obj(i) Is MSForms.ListBox Then
Set lis = obj(i): result = lis.Name
ElseIf TypeOf obj(i) Is MSForms.TextBox Then
Set txt = obj(i): result = txt.Name
ElseIf TypeOf obj(i) Is MSForms.CommandButton Then
Set btn = obj(i): result = btn.Name
ElseIf TypeOf obj(i) Is MSForms.ComboBox Then
Set ComboBox = obj(i): result = com.Name
Else
result = ""
End If
If (Not (result = "")) Then Debug.Print TypeName(obj(i)) & "  name= " & result
Next i
For i = 1 To numObjects
Set lis = IsListBox(obj(i))
Set txt = IsTextBox(obj(i))
Set btn = IsCommandButton(obj(i))
Set com = IsComboBox(obj(i))
result = ""
If (Not (lis Is Nothing)) Then
result = "ListBox " & lis.Name
ElseIf (Not (txt Is Nothing)) Then
result = "TexttBox " & txt.Name
ElseIf (Not (btn Is Nothing)) Then
result = "CommandButton " & btn.Name
ElseIf (Not (com Is Nothing)) Then
result = "ComboBox " & com.Name
End If
Debug.Print result
Next i
End Sub
Function IsListBox(obj As Object) As MSForms.ListBox
Set IsListBox = IIf(TypeOf obj Is MSForms.ListBox, obj, Nothing)
End Function
Function IsTextBox(obj As Object) As MSForms.TextBox
Set IsTextBox = IIf(TypeOf obj Is MSForms.TextBox, obj, Nothing)
End Function
Function IsComboBox(obj As Object) As MSForms.ComboBox
Set IsComboBox = IIf(TypeOf obj Is MSForms.ComboBox, obj, Nothing)
End Function
Function IsCommandButton(obj As Object) As MSForms.CommandButton
Set IsCommandButton = IIf(TypeOf obj Is MSForms.CommandButton, obj, Nothing)
End Function

它的一个用途是在一个类中处理事件的类。

Private WithEvents intEvents As IntBoxEvents
Private WithEvents decEvents As DecBoxEvents
Private genEvents As Object
Private genControl as OLEobject
Public sub Delegate(ctrl As OLEObject)
set genControl = ctrl 
' Code for creating intEvents or decEvents 
if .... create intevents.... then set genEvents = new IntEvents ' pseudo code
if .... create decevents.... then set genEvents = new DecEvents ' pseudo code
end sub

我希望这可以帮助其他在铸造控制方面遇到困难的人