当前位置: 动力学知识库 > 问答 > 编程问答 >

excel - Runtime error when passing a class as a Variant argument

问题描述:

When I do this:

Dim data_set As DataSet

Set data_set = New DataSet

'some meaningless operations here

list.Add CVar(data_set)

on the list.Add line, I get a run-time error 13, arguing for a type mismatch.

This is the header of the Add sub:

Public Sub Add(ByRef vItem As Variant, Optional index As Long)

What am I missing here?

EDIT:

Just enabled all errors, and it fails on this piece of code, now with a Run-Time error 9:

Private Function GetListCount() As Long

ClearError

On Error GoTo Err

GetListCount = UBound(mList) - LBound(mList) + 1

Exit Function

Err:

GetListCount = 0

End Function

And here's the mList definition:

Private mList() As Variant

EDIT2: Here's the constructor:

'==============================

'Constructor

'==============================

Public Sub Initialize()

Disposed = False

ReDim mList(0)

End Sub

Public Function CreateInstance() As ListClass

Dim oNew As New ListClass

oNew.Initialize

Set CreateInstance = oNew

End Function

EDIT3: By request here are the entire modules... First the ListClass

Private mList() As Variant

Private mError As Error

Private mDisposed As Boolean

'==============================

'Constructor

'==============================

Public Sub Initialize()

Disposed = False

ReDim mList(0)

End Sub

Public Function CreateInstance() As ListClass

Dim oNew As New ListClass

oNew.Initialize

Set CreateInstance = oNew

End Function

'==============================

'Properties

'==============================

Public Property Get Items(ByRef index As Long) As Variant

Items = GetItemAtIndex(index)

End Property

Public Property Get Count() As Long

Count = GetListCount()

End Property

Public Property Get GotError() As Boolean

If ListError Is Nothing Then GotError = False Else GotError = True

End Property

Public Property Get ListItems() As Variant()

ClearError

On Error GoTo Err

ListItems = mList

Exit Property

Err:

ListError = Err

End Property

Public Property Get ListError() As Error

ListError = mError

End Property

Private Property Let ListError(ByRef vError As Error)

Set mError = vError

End Property

Public Property Get Disposed() As Boolean

Disposed = mDisposed

End Property

Private Property Let Disposed(ByRef vValue As Boolean)

mDisposed = vValue

End Property

Public Property Get ToArray()

ToArray = mList

End Property

'==============================

'Public Methods

'==============================

Public Sub Remove(ByRef vItem As Variant)

DeleteElement (vItem)

End Sub

Public Sub RemoveAtIndex(ByRef index As Long)

DeleteElementAt (index)

End Sub

Public Sub Sort()

BubbleSort (mList)

End Sub

Public Sub Clear()

Erase mList

End Sub

Public Function Find(ByRef vItem As Variant) As Long

Find = FindItem(vItem)

End Function

Public Sub Dispose()

ResetError

Clear

Disposed = True

End Sub

Public Sub ResetError()

ClearError

End Sub

Public Function LastIndexOf(ByRef vItem As Variant)

LastIndexOf = GetLastIndexOf(vItem)

End Function

Public Function IndexOf(ByRef vItem As Variant)

IndexOf = FindItem(vItem)

End Function

Public Sub Reverse()

ReverseList

End Sub

Public Function Exists(vItem As Variant)

Exists = ItemExists(vItem)

End Function

Public Sub Add(ByRef vItem As Variant, Optional index As Long)

If index > 0 Then

AddItemAt index, vItem

Else

AddItem vItem

End If

End Sub

Public Function Contains(ByRef vItem As Variant)

Contains = Exists(vItem)

End Function

Public Function Copy() As ListClass

Set Copy = GetCopy

End Function

Public Sub RemoveAll()

Clear

End Sub

'==============================

'Private Methods

'==============================

Private Sub ClearError()

Set mError = Nothing

End Sub

Private Function GetListCount() As Long

ClearError

On Error GoTo Err

GetListCount = UBound(mList) - LBound(mList) + 1 'and error happens here

Exit Function

Err:

GetListCount = 0

End Function

Private Function GetItemAtIndex(ByRef index As Long) As Variant

ClearError

On Error GoTo Err

GetItemAtIndex = mList(index)

Exit Function

Err:

ListError = Err

GetItemAtIndex = Nothing

End Function

Private Sub AddItemAt(index As Long, vItem As Variant)

ClearError

On Error GoTo Err

Dim ar() As Variant

Dim i As Integer

i = Count

ReDim ar(i)

For a = 0 To index - 1

ar(a) = mList(a)

Next

ar(index) = vItem

For a = index + 1 To i

ar(a) = mList(a - 1)

Next

mList = ar

Exit Sub

Err:

ListError = Err

End Sub

Private Sub BubbleSort(ByVal vArray As Variant)

ClearError

On Error GoTo Err

Dim i As Long

Dim iMin As Long

Dim iMax As Long

Dim vSwap As Variant

Dim swapped As Boolean

iMin = LBound(vArray)

iMax = UBound(vArray) - 1

Do

swapped = False

For i = iMin To iMax

If vArray(i) > vArray(i + 1) Then

vSwap = vArray(i)

vArray(i) = vArray(i + 1)

vArray(i + 1) = vSwap

swapped = True

End If

Next

iMax = iMax - 1

Loop Until Not swapped

mList = vArray

Erase vArray

Exit Sub

Err:

ListError = Err

End Sub

Private Sub DeleteElementAt(index As Integer)

ClearError

On Error GoTo Err

Dim i As Integer

For i = index + 1 To Count - 1

mList(i - 1) = mList(i)

Next

ReDim Preserve mList(Count - 2)

Exit Sub

Err:

ListError = Err

End Sub

Private Sub DeleteElement(ByRef vItem As Variant)

ClearError

On Error GoTo Err

DeleteElementAt (FindItem(vItem))

Exit Sub

Err:

ListError = Err

End Sub

Private Sub AddItem(vItem As Variant)

ClearError

On Error GoTo Err

Dim i As Long

i = Count

ReDim Preserve mList(i)

mList(i) = vItem

Exit Sub

Err:

ListError = Err

End Sub

Private Function FindItem(vItem As Variant) As Long

ClearError

On Error GoTo Err

FindItem = -1

For i = 0 To Count - 1

If mList(i) = vItem Then

FindItem = i

Exit For

End If

Next i

Exit Function

Err:

ListError = Err

FindItem = -1

End Function

Private Function GetLastIndexOf(vItem As Variant) As Long

ClearError

On Error GoTo Err

GetLastIndexOf = -1

Dim i As Long

For i = Count - 1 To 0 Step -1

If mList(i) = vItem Then

GetLastIndexOf = i

Exit Function

End If

Next i

Exit Function

Err:

ListError = Err

GetLastIndexOf = -1

End Function

Private Sub ReverseList()

ClearError

On Error GoTo Err

Dim ar() As Variant

Dim i As Long

Dim j As Long

If Count = 0 Then Exit Sub

i = Count - 1

j = i

ReDim ar(i)

For a = 0 To i

ar(a) = mList(j)

j = j - 1

Next a

mList = ar

Erase ar

Exit Sub

Err:

ListError = Err

End Sub

Private Function ItemExists(vItem As Variant) As Boolean

If FindItem(vItem) > -1 Then

ItemExists = True

Else

ItemExists = False

End If

End Function

Private Function GetCopy() As ListClass

Dim list As New ListClass

Set list = list.CreateInstance

For i = 0 To Count - 1

list.Add mList(i)

Next i

Set GetCopy = list

i = GetCopy.Count

End Function

And now the function where the error is happening...

Function ReadData() As ListClass

'instanteate list

Dim list As ListClass

Set list = New ListClass

'get sheets

Dim sheet As Worksheet

Set sheet = Sheets("Data")

Dim dataSheet As Worksheet

Set dataSheet = Sheets("DataSet")

'read lines and store them on list

Dim i As Integer

i = 2

Do While sheet.Cells(i, 1) <> ""

Dim data_set As DataSet

Set data_set = New DataSet

data_set.entry_spread = CSng(dataSheet.Cells(i, 7).Value)

data_set.result = CSng(dataSheet.Cells(i, 12).Value)

data_set.lot = CInt(dataSheet.Cells(i, 13).Value)

data_set.win = IIf(UCase(dataSheet.Cells(i, 15).Value) = "YES", True, False)

data_set.group = CInt(dataSheet.Cells(i, 20).Value)

data_set.atr = CSng(dataSheet.Cells(i, 21).Value)

data_set.pdr = CSng(dataSheet.Cells(i, 22).Value)

data_set.ir = CSng(dataSheet.Cells(i, 23).Value)

data_set.fib = dataSheet.Cells(i, 24).Value

data_set.slipage = CSng(dataSheet.Cells(i, 25).Value)

data_set.slipread = CSng(dataSheet.Cells(i, 26).Value)

list.Add CVar(data_set) 'error happens here...

i = i + 1

Loop

ReadData = list

End Function

网友答案:

You don't need to create your own constructor as you are not passing any arguments - so you can just use the Class_Initialize event. Replace this:

'==============================
'Constructor
'==============================
Public Sub Initialize()
    Disposed = False
    ReDim mList(0)
End Sub

Public Function CreateInstance() As ListClass
    Dim oNew As New ListClass
    oNew.Initialize
    Set CreateInstance = oNew
End Function

with this:

Private Sub Class_Initialize()
    Disposed = False
    ReDim mList(0)
End Sub

and remember to remove this line from the GetCopy function:

Set list = list.CreateInstance

Edit: forgot to mention that because you are passing Objects, you need to use Set when assigning them to the array mList.

分享给朋友:
您可能感兴趣的文章:
随机阅读: