vba - 查看接口类时,VBE 和 Excel 在调试时崩溃
问题描述
我已经实现了一个实现接口的 VBA 类。我的问题是,在我的实现类存储到接口类之后,我无法调试创建的类。该类工作正常,如果表现正常。当我尝试在 VBE 调试器的本地窗口中展开变量时,崩溃发生可重现。
如果这是 VBA 中的一个已知错误,那么我会因为没有在谷歌上找到这个而感到羞耻。
如果我的类和界面有设计错误,也许你可以帮我找到它。
我在一个空工作簿中使用一个标准模块和两个类模块。这Attribute Value.VB_UserMemId = 0
只是一个提醒。它不适合通过 export+ioprt 的代码。很抱歉我的评论是用德语 :P 的。正如我所指出的,我不知道代码的哪一部分导致了问题。因此,我提供了一个带有类和接口的功能齐全的测试例程。
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
编辑:我发现这个问题似乎与我的相似。但是对于不匹配的数据类型只是一个提示,它没有得到答复。 在本地查看对象或观察窗口导致 excel 崩溃
我有 testet 评论我的属性。在界面中评论Public Property Get Columns() As xCol()
解决了崩溃。但仍然没有其他属性显示值。object doesn't support this property or method
即使 x 值显示数据,也会显示所有属性。
解决方案
我能够使用您的代码重现相同的行为(崩溃)。从界面中删除成员Columns
,Column
和后,不再崩溃。但是,当在调试器中展开接口对象时,我们得到消息Object doesn't support this property or method,而不是值,正如在如何获取在 Locals 窗口中实现接口的类的属性值中报告的那样?,对此没有答案。所以,即使 Excel 没有崩溃,在调试器本地窗口中扩展接口变量也是没有用的。Data
IxTable
ix
我还在 Expert Exchange 上找到了文章Interfaces in VBA - How to use them and how to work around them,其中报告了与 VBA 接口相关的几个问题。
恐怕VBA接口并不是VBA最稳定的特性。
上面的专家交流文章提出了 VBA 接口的替代解决方案,我认为值得一看,因为最终结果是相同的。文章太长,无法在此处复制,但专家交流网站“永久”足以仅在此处留下文章的链接。
推荐阅读
- sql - 如何分组并保留特定列
- c# -
统一与 MySQL | 脚本在编辑器中有效,但在构建中无效 - bash - 在 ubuntu 中查找动态公共 IP 地址的 shell 脚本不显示任何输出
- java - CassandraDataSource JDBC 作为数据源
- android - 同时运行 10 个 kotlin 异步协程
- mongodb - 在一个文档中查找 mongodb 重复字段
- html-agility-pack - html 敏捷包 url 抓取 href
- react-native - 嵌套导航问题 - 如何导出 BottomTabNavigator
- generics - Rust 特征边界与类型
- database - 查找在 id 列中出现一次并具有标志 1 的所有 id