VBE 和 Excel 在查看接口 class 时在调试时崩溃
VBE and Excel crashing on debugging when viewing interfaced class
我已经实现了一个正在实现接口的 VBA class。我的问题是，在我的实现 class 存储到接口 class 之后，我无法调试创建的 class。 class 工作正常，如果表现正常。当我尝试在 VBE 调试器的局部 window 中扩展变量时，崩溃发生可重现。
如果这是 VBA 中的已知错误，那么我很遗憾没有在 google 上找到它。
如果我的 class 和界面有设计错误，也许你能帮我找到它。
我在一个空工作簿中使用了一个标准模块和两个 class 模块。 Attribute Value.VB_UserMemId = 0 只是一个提醒。不通过export+imoprt适配代码。很抱歉我的评论是德语的：P。正如我所指出的，我不知道是代码的哪一部分导致了问题。因此，我提供了具有 class 和接口的全功能测试例程。
IxTable
Option Explicit
Public Property Get Name() As String
End Property
Public Property Get Columns() As xCol()
End Property
Public Property Get Column(ByVal Index) As xCol
End Property
'Attribute Value.VB_UserMemId = 0
Public Property Get Data(ByVal Row As Long, ByVal Column) As String
End Property
Public Property Get RowCount() As Long
End Property
Public Property Get ColumnCount() As Long
End Property
Public Function ToString() As String
End Function
xTable
Option Explicit
Implements IxTable
' Private Speichervariablen
Private c() As xCol ' Spalteneigenschaften
Private d As Variant ' Datenfeld Data(Row,Col)
Private n As String ' Name der Tabelle
' Buffer für Spaltenzugriff
Private lastColNumber As Long
Private lastColName As String
''' <summary>
''' Initialisierung des zweidimentionalen Datenfeldes als Data(1,1)
''' </summary>
Private Sub Class_Initialize()
ReDim d(1 To 1, 1 To 1) As Variant
Erase d
End Sub
''' <summary>
''' Name der abgefragten Tabelle
''' </summary>
Public Property Get Name() As String
Let Name = n
End Property
Public Property Get IxTable_Name() As String
Let IxTable_Name = Me.Name
End Property
''' <summary>
''' Ergänzung für Initialisierung
''' </summary>
Friend Property Let Name(ByVal value As String)
n = value
End Property
''' <summary>
''' Zugriff auf alle Spalten
''' </summary>
Public Property Get Columns() As xCol()
Let Columns = c
End Property
Public Property Get IxTable_Columns() As xCol()
Let IxTable_Columns = Me.Columns
End Property
''' <summary>
''' Zugriff aus einzelne Spalte
''' </summary>
Public Property Get Column(ByVal Index) As xCol
Let Column = c(ColumnIndex(Index))
End Property
Public Property Get IxTable_Column(ByVal Index) As xCol
Let IxTable_Column = Me.Column(Index)
End Property
''' <summary>
''' Umsetzung von Spaltenname zu Index mit Buffer
''' </summary>
''' <param name="index">Name oder Index</param>
''' <returns>Index numerisch</returns>
Private Function ColumnIndex(ByVal Index) As Long
If IsNumeric(Index) Then
Let ColumnIndex = CLng(Index)
If Not ColumnIndex = lastColNumber Then
' Letzten Zugriff aktualisieren
lastColNumber = ColumnIndex
lastColName = c(lastColNumber).Name
End If
Else
' Gleiche Spalte wie letzter Zugriff?
If Index = lastColName Then
' Index aus Speicher
ColumnIndex = lastColNumber
Else
' Spalte suchen
lastColName = Index
For lastColNumber = 1 To Me.ColumnCount
If c(lastColNumber).Name = Index Then Exit For
Next
Let ColumnIndex = lastColNumber
End If
End If
If ColumnIndex > UBound(c) Then ColumnIndex = 0
End Function
''' <summary>
''' Ergänzung für Initialisierung
''' </summary>
Friend Sub SetColumn(ByVal Index As Long, value As xCol)
c(Index).Index = Index
c(Index).Name = value.Name
c(Index).Length = value.Length
c(Index).Offset = value.Offset
c(Index).Decimals = value.Decimals
c(Index).Inttype = value.Inttype
c(Index).xType = value.xType
c(Index).Text = value.Text
lastColNumber = 0
lastColName = vbNullString
End Sub
''' <summary>
''' Zugriff auf das Datenfeld
''' </summary>
'Attribute Value.VB_UserMemId = 0
Public Property Get Data(ByVal Row As Long, ByVal Column) As String
Column = ColumnIndex(Column)
Let Data = d(Row, Column)
End Property
Public Property Get IxTable_Data(ByVal Row As Long, ByVal Column) As String
Let IxTable_Data = Me.Data(Row, Column)
End Property
''' <summary>
''' Ergänzung für Initialisierung
''' Daten sind READ ONLY
''' </summary>
Friend Property Let Data(ByVal Row As Long, ByVal Column, ByVal value As String)
Column = ColumnIndex(Column)
d(Row, Column) = Trim(value)
End Property
''' <summary>
''' Anzahl der Spalten
''' </summary>
Public Property Get ColumnCount() As Long
On Error Resume Next
Let ColumnCount = UBound(c)
On Error GoTo 0
End Property
Public Property Get IxTable_ColumnCount() As Long
Let IxTable_ColumnCount = Me.ColumnCount
End Property
''' <summary>
''' Anzahl der Zeilen
''' </summary>
Public Property Get RowCount() As Long
On Error Resume Next
Let RowCount = UBound(d, 1)
On Error GoTo 0
End Property
Public Property Get IxTable_RowCount() As Long
Let IxTable_RowCount = Me.RowCount
End Property
''' <summary>
''' Ergänzung für Initialisierung
''' </summary>
Friend Sub SetSize(ByVal Rows As Long, ByVal Columns As Long)
ColumnCount = Columns
Me.SetRowCount Rows
End Sub
Friend Sub SetRowCount(ByVal Rows As Long)
RowCount = Rows
End Sub
Private Property Let ColumnCount(ByVal value As Long)
ReDim c(1 To value)
lastColNumber = 0
lastColName = vbNullString
End Property
Private Property Let RowCount(ByVal value As Long)
If value > 0 Then
ReDim d(1 To value, 1 To Me.ColumnCount) As String
Else
On Error Resume Next
Erase d
On Error GoTo 0
End If
End Property
''' <summary>
''' Ausgabe des Datenfeldes als String
''' </summary>
''' <returns>
''' Col1\tCol2\t...\tColn
''' d(1,1)\td(1,2)\td(1,n)
''' ...
''' d(m,1)\td(m,2)\td(m,n)
''' </returns>
Public Function ToString() As String
Dim r As Long, i As Long, typing As String, descriptions As String
For i = 1 To Me.ColumnCount
If i = 1 Then
ToString = c(i).Name
typing = c(i).Inttype & "(" & c(i).Length & ")"
descriptions = c(i).Text
Else
ToString = ToString & vbTab & c(i).Name
typing = typing & vbTab & c(i).Inttype & "(" & c(i).Length & ")"
descriptions = descriptions & vbTab & c(i).Text
End If
Next
ToString = ToString & vbCrLf & typing & vbCrLf & descriptions
For r = 1 To Me.RowCount
ToString = ToString & vbCrLf
For i = 1 To Me.ColumnCount
If i = 1 Then
ToString = ToString & Me.Data(r, i)
Else
ToString = ToString & vbTab & Me.Data(r, i)
End If
Next
Next
End Function
Public Function IxTable_ToString() As String
Let IxTable_ToString = Me.ToString
End Function
最后，这是测试模块。
Module1
Option Explicit
Public Enum xType
'String RFC
TypeChar = 0
'Date RFC
TypeDate = 1
'Numerical
TypeNum = 2
End Enum
''' <summary>
''' Spalteneigenschaften
''' </summary>
Public Type xCol
Index As Long
Name As String
Decimals As Integer
Length As Integer
Offset As Long
Inttype As String
xType As xType
TypeName As String
Text As String
End Type
Sub testIt()
Dim x As xTable, ix As IxTable
'works fine
Set x = xTableTest
'output is nice
Debug.Print x.ToString
'works fine
Set ix = x
' ---> At this point x can be viewed in the locals window (all the time!)
' ---> ix causes Excel to crash and restart
'output is nice
Debug.Print ix.ToString
End Sub
Function xTableTest() As xTable
Dim x As New xTable
Dim c1 As xCol, c2 As xCol
x.SetSize 3, 2
c1.Name = "INDEX"
c1.Length = 8
c1.Text = "Index value"
c1.Index = 1
c1.Offset = 0
c1.Inttype = "Integer"
c1.xType = xType.TypeNum
x.SetColumn 1, c1
c2.Name = "TEXT"
c2.Length = 20
c2.Text = "Text value"
c2.Index = 2
c2.Offset = 8
c2.Inttype = "String"
c2.xType = xType.TypeChar
x.SetColumn 2, c2
Let x.Data(1, c1.Index) = 100
Let x.Data(1, c2.Index) = "einhundert"
Let x.Data(2, c1.Index) = 200
Let x.Data(2, c2.Index) = "zweihundert"
Let x.Data(3, c1.Index) = 210
Let x.Data(3, c2.Index) = "zweihundertzehn"
Set xTableTest = x
End Function
编辑：我发现这个问题与我的相似。但是，对于不匹配的数据类型，它只是一个 hin 没有答案。
viewing-an-object-in-locals-or-watch-window-causes-excel-to-crash
我有 testet 评论我的属性。在界面中注释 Public Property Get Columns() As xCol() 解决了崩溃。但是其他属性的 none 仍然显示一个值。即使 x 值显示数据，所有属性也显示 object doesn't support this property or method。
我能够使用您的代码重现相同的行为（崩溃）。从 IxTable 接口中删除成员 Columns、Column 和 Data 后，不再崩溃。但是，当在调试器中扩展接口对象 ix 时，我们得到消息 Object doesn't support this 属性 or method，而不是值正如 How to get property values of classes that implement an interface in the Locals window? 中所报告的那样，没有答案。所以，即使 Excel 不崩溃，在调试器本地扩展接口变量 window 也是没有用的。
我还在 Expert Exchange 上找到了文章 Interfaces in VBA - How to use them and how to work around them，其中报告了与 VBA 接口相关的几个问题。
恐怕 VBA 接口不是 VBA 最稳定的功能。
上面的 Expert Exchange 文章提出了 VBA 接口的替代解决方案，我认为值得一看，因为最终结果是一样的。文章太长，此处无法复制，但专家交流网站 "permanent" 够了，这里只留一个 link 给文章。
我已经实现了一个正在实现接口的 VBA class。我的问题是，在我的实现 class 存储到接口 class 之后，我无法调试创建的 class。 class 工作正常，如果表现正常。当我尝试在 VBE 调试器的局部 window 中扩展变量时，崩溃发生可重现。
如果这是 VBA 中的已知错误，那么我很遗憾没有在 google 上找到它。
如果我的 class 和界面有设计错误，也许你能帮我找到它。
我在一个空工作簿中使用了一个标准模块和两个 class 模块。 Attribute Value.VB_UserMemId = 0 只是一个提醒。不通过export+imoprt适配代码。很抱歉我的评论是德语的：P。正如我所指出的，我不知道是代码的哪一部分导致了问题。因此，我提供了具有 class 和接口的全功能测试例程。
IxTable
Option Explicit
Public Property Get Name() As String
End Property
Public Property Get Columns() As xCol()
End Property
Public Property Get Column(ByVal Index) As xCol
End Property
'Attribute Value.VB_UserMemId = 0
Public Property Get Data(ByVal Row As Long, ByVal Column) As String
End Property
Public Property Get RowCount() As Long
End Property
Public Property Get ColumnCount() As Long
End Property
Public Function ToString() As String
End Function
xTable
Option Explicit
Implements IxTable
' Private Speichervariablen
Private c() As xCol ' Spalteneigenschaften
Private d As Variant ' Datenfeld Data(Row,Col)
Private n As String ' Name der Tabelle
' Buffer für Spaltenzugriff
Private lastColNumber As Long
Private lastColName As String
''' <summary>
''' Initialisierung des zweidimentionalen Datenfeldes als Data(1,1)
''' </summary>
Private Sub Class_Initialize()
ReDim d(1 To 1, 1 To 1) As Variant
Erase d
End Sub
''' <summary>
''' Name der abgefragten Tabelle
''' </summary>
Public Property Get Name() As String
Let Name = n
End Property
Public Property Get IxTable_Name() As String
Let IxTable_Name = Me.Name
End Property
''' <summary>
''' Ergänzung für Initialisierung
''' </summary>
Friend Property Let Name(ByVal value As String)
n = value
End Property
''' <summary>
''' Zugriff auf alle Spalten
''' </summary>
Public Property Get Columns() As xCol()
Let Columns = c
End Property
Public Property Get IxTable_Columns() As xCol()
Let IxTable_Columns = Me.Columns
End Property
''' <summary>
''' Zugriff aus einzelne Spalte
''' </summary>
Public Property Get Column(ByVal Index) As xCol
Let Column = c(ColumnIndex(Index))
End Property
Public Property Get IxTable_Column(ByVal Index) As xCol
Let IxTable_Column = Me.Column(Index)
End Property
''' <summary>
''' Umsetzung von Spaltenname zu Index mit Buffer
''' </summary>
''' <param name="index">Name oder Index</param>
''' <returns>Index numerisch</returns>
Private Function ColumnIndex(ByVal Index) As Long
If IsNumeric(Index) Then
Let ColumnIndex = CLng(Index)
If Not ColumnIndex = lastColNumber Then
' Letzten Zugriff aktualisieren
lastColNumber = ColumnIndex
lastColName = c(lastColNumber).Name
End If
Else
' Gleiche Spalte wie letzter Zugriff?
If Index = lastColName Then
' Index aus Speicher
ColumnIndex = lastColNumber
Else
' Spalte suchen
lastColName = Index
For lastColNumber = 1 To Me.ColumnCount
If c(lastColNumber).Name = Index Then Exit For
Next
Let ColumnIndex = lastColNumber
End If
End If
If ColumnIndex > UBound(c) Then ColumnIndex = 0
End Function
''' <summary>
''' Ergänzung für Initialisierung
''' </summary>
Friend Sub SetColumn(ByVal Index As Long, value As xCol)
c(Index).Index = Index
c(Index).Name = value.Name
c(Index).Length = value.Length
c(Index).Offset = value.Offset
c(Index).Decimals = value.Decimals
c(Index).Inttype = value.Inttype
c(Index).xType = value.xType
c(Index).Text = value.Text
lastColNumber = 0
lastColName = vbNullString
End Sub
''' <summary>
''' Zugriff auf das Datenfeld
''' </summary>
'Attribute Value.VB_UserMemId = 0
Public Property Get Data(ByVal Row As Long, ByVal Column) As String
Column = ColumnIndex(Column)
Let Data = d(Row, Column)
End Property
Public Property Get IxTable_Data(ByVal Row As Long, ByVal Column) As String
Let IxTable_Data = Me.Data(Row, Column)
End Property
''' <summary>
''' Ergänzung für Initialisierung
''' Daten sind READ ONLY
''' </summary>
Friend Property Let Data(ByVal Row As Long, ByVal Column, ByVal value As String)
Column = ColumnIndex(Column)
d(Row, Column) = Trim(value)
End Property
''' <summary>
''' Anzahl der Spalten
''' </summary>
Public Property Get ColumnCount() As Long
On Error Resume Next
Let ColumnCount = UBound(c)
On Error GoTo 0
End Property
Public Property Get IxTable_ColumnCount() As Long
Let IxTable_ColumnCount = Me.ColumnCount
End Property
''' <summary>
''' Anzahl der Zeilen
''' </summary>
Public Property Get RowCount() As Long
On Error Resume Next
Let RowCount = UBound(d, 1)
On Error GoTo 0
End Property
Public Property Get IxTable_RowCount() As Long
Let IxTable_RowCount = Me.RowCount
End Property
''' <summary>
''' Ergänzung für Initialisierung
''' </summary>
Friend Sub SetSize(ByVal Rows As Long, ByVal Columns As Long)
ColumnCount = Columns
Me.SetRowCount Rows
End Sub
Friend Sub SetRowCount(ByVal Rows As Long)
RowCount = Rows
End Sub
Private Property Let ColumnCount(ByVal value As Long)
ReDim c(1 To value)
lastColNumber = 0
lastColName = vbNullString
End Property
Private Property Let RowCount(ByVal value As Long)
If value > 0 Then
ReDim d(1 To value, 1 To Me.ColumnCount) As String
Else
On Error Resume Next
Erase d
On Error GoTo 0
End If
End Property
''' <summary>
''' Ausgabe des Datenfeldes als String
''' </summary>
''' <returns>
''' Col1\tCol2\t...\tColn
''' d(1,1)\td(1,2)\td(1,n)
''' ...
''' d(m,1)\td(m,2)\td(m,n)
''' </returns>
Public Function ToString() As String
Dim r As Long, i As Long, typing As String, descriptions As String
For i = 1 To Me.ColumnCount
If i = 1 Then
ToString = c(i).Name
typing = c(i).Inttype & "(" & c(i).Length & ")"
descriptions = c(i).Text
Else
ToString = ToString & vbTab & c(i).Name
typing = typing & vbTab & c(i).Inttype & "(" & c(i).Length & ")"
descriptions = descriptions & vbTab & c(i).Text
End If
Next
ToString = ToString & vbCrLf & typing & vbCrLf & descriptions
For r = 1 To Me.RowCount
ToString = ToString & vbCrLf
For i = 1 To Me.ColumnCount
If i = 1 Then
ToString = ToString & Me.Data(r, i)
Else
ToString = ToString & vbTab & Me.Data(r, i)
End If
Next
Next
End Function
Public Function IxTable_ToString() As String
Let IxTable_ToString = Me.ToString
End Function
最后，这是测试模块。
Module1
Option Explicit
Public Enum xType
'String RFC
TypeChar = 0
'Date RFC
TypeDate = 1
'Numerical
TypeNum = 2
End Enum
''' <summary>
''' Spalteneigenschaften
''' </summary>
Public Type xCol
Index As Long
Name As String
Decimals As Integer
Length As Integer
Offset As Long
Inttype As String
xType As xType
TypeName As String
Text As String
End Type
Sub testIt()
Dim x As xTable, ix As IxTable
'works fine
Set x = xTableTest
'output is nice
Debug.Print x.ToString
'works fine
Set ix = x
' ---> At this point x can be viewed in the locals window (all the time!)
' ---> ix causes Excel to crash and restart
'output is nice
Debug.Print ix.ToString
End Sub
Function xTableTest() As xTable
Dim x As New xTable
Dim c1 As xCol, c2 As xCol
x.SetSize 3, 2
c1.Name = "INDEX"
c1.Length = 8
c1.Text = "Index value"
c1.Index = 1
c1.Offset = 0
c1.Inttype = "Integer"
c1.xType = xType.TypeNum
x.SetColumn 1, c1
c2.Name = "TEXT"
c2.Length = 20
c2.Text = "Text value"
c2.Index = 2
c2.Offset = 8
c2.Inttype = "String"
c2.xType = xType.TypeChar
x.SetColumn 2, c2
Let x.Data(1, c1.Index) = 100
Let x.Data(1, c2.Index) = "einhundert"
Let x.Data(2, c1.Index) = 200
Let x.Data(2, c2.Index) = "zweihundert"
Let x.Data(3, c1.Index) = 210
Let x.Data(3, c2.Index) = "zweihundertzehn"
Set xTableTest = x
End Function
编辑：我发现这个问题与我的相似。但是，对于不匹配的数据类型，它只是一个 hin 没有答案。 viewing-an-object-in-locals-or-watch-window-causes-excel-to-crash
我有 testet 评论我的属性。在界面中注释 Public Property Get Columns() As xCol() 解决了崩溃。但是其他属性的 none 仍然显示一个值。即使 x 值显示数据，所有属性也显示 object doesn't support this property or method。
我能够使用您的代码重现相同的行为（崩溃）。从 IxTable 接口中删除成员 Columns、Column 和 Data 后，不再崩溃。但是，当在调试器中扩展接口对象 ix 时，我们得到消息 Object doesn't support this 属性 or method，而不是值正如 How to get property values of classes that implement an interface in the Locals window? 中所报告的那样，没有答案。所以，即使 Excel 不崩溃，在调试器本地扩展接口变量 window 也是没有用的。
我还在 Expert Exchange 上找到了文章 Interfaces in VBA - How to use them and how to work around them，其中报告了与 VBA 接口相关的几个问题。
恐怕 VBA 接口不是 VBA 最稳定的功能。
上面的 Expert Exchange 文章提出了 VBA 接口的替代解决方案，我认为值得一看，因为最终结果是一样的。文章太长，此处无法复制，但专家交流网站 "permanent" 够了，这里只留一个 link 给文章。