Search code examples
vbadebuggingcrashlocal-variablesvbe

VBE and Excel crashing on debugging when viewing interfaced class

I have implemented a VBA class that is implementing an interface. My Problem is, that I cannot debug the created class, after my implementing class is stored into the interface class. The class just works fine and if behaved noarmal. The crash occures reproducable when I try to expand the variable in locals window of the VBE debugger.

If that is a known bug in VBA then shame on me for not finding this on google.

If there is a design error in my class and interface, maybe you can help me finding it.

I use one standard module and two class modules in an empty workbook. The Attribute Value.VB_UserMemId = 0 is just a reminder. It is not adapted to the code via export+imoprt. I'm sorry for my comments are in German :P . As I pointed out, I don't know which part of the code causes the problem. Therefore I provide a fully functional test routine with the class and interface.

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

And finally, here is the test module.

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

locals window of VBE

EDIT: I Found this question whitch seem similar to mine. But it is unanswered with just a hin on mismatching data types. viewing-an-object-in-locals-or-watch-window-causes-excel-to-crash

I have testet commenting my properties. Commenting Public Property Get Columns() As xCol() in the interface solved the crash. But still none of the other properties shows a value. All properties display object doesn't support this property or method even when the x value shows data.

Solution

  • I was able to reproduce the same behavior (crash) using your code. After removing the members Columns, Column, and Data from the IxTable interface, no more crash. However, when expanding the interface object ix in the debugger, instead of the values, we have the message Object doesn't support this property or method, exactly as reported in How to get property values of classes that implement an interface in the Locals window?, for which there is no answer. So, even when Excel does not crash, expanding the interface variable in the debugger local window is useless.

    I also found the article Interfaces in VBA - How to use them and how to work around them on Expert Exchange, where several issues related to VBA interfaces are reported.

    I am afraid that VBA interfaces are not the most stable feature of VBA.

    The Expert Exchange article above proposes an alternative solution to VBA interfaces that I believe is worth looking at, for the end result is the same. The article is too long to be replicated here, but the Expert Exchange site is "permanent" enough to only leave here a link to the article.