问题
I'm getting a Type Mismatch-error, when trying to retrieve items from my collection.
What I mainly want to do, is to collect all customers within as collection, and past all results on my ListBox for visualization. The reason why I'm using a class-module is due to the fact, that UDT are pasting an error: "Only user-defined types defined in public object modules can be coerced to or from a variant or passed to late-bound functions". So I started programming all properties in classes instead, but I haven't really worked with classes before, so it's pretty new to me.
I'm facing another issue; the .additem-property is limited to 9 columns (on the ListBox), and therefore I'd like to use another method for this. Array is unlimited, and rowsources are limited to 256 or 255. I'd like 14 columns to be shown on the ListBox, and furthermore have the ability to expand if needed later on.
ListView aren't really an option due to the fact, that many computers doesn't have this reference integrated.
Class-module. "clsCustomers"
Option Explicit
Private cID As String
Private cCustomerName As String
Private cCompanyName As String
Private cFullName As String
Private cCVR As Long
Private cType As String
Private cGroup As String
Private cCountry As String
Private cStreet As String
Private cZipcode As Variant
Private cCity As String
Private cPhoneNum As Long
Private cMobileNum As Long
Private cEmail As String
Private cInvoiceEmail As String
Private cCreationDate As Date
Private cLastChange As Date
Public Property Get customerID() As String
customerID = cID
End Property
Public Property Let customerID(value As String)
cID = value
End Property
Public Property Get customerName() As String
customerName = cCustomerName
End Property
Public Property Let customerName(value As String)
cCustomerName = value
End Property
Public Property Get customerCompanyName() As String
customerCompanyName = cCompanyName
End Property
Public Property Let customerCompanyName(value As String)
cCompanyName = value
End Property
Public Property Get customerFullName() As String
customerFullName = cFullName
End Property
Public Property Let customerFullName(value As String)
cFullName = value
End Property
Public Property Get customerCVR() As Long
customerCVR = cCVR
End Property
Public Property Let customerCVR(value As Long)
cCVR = value
End Property
Public Property Get customerType() As String
customerType = cType
End Property
Public Property Let customerType(value As String)
cType = value
End Property
Public Property Get customerGroup() As String
customerGroup = cGroup
End Property
Public Property Let customerGroup(value As String)
cGroup = value
End Property
Public Property Get customerCountry() As String
customerCountry = cCountry
End Property
Public Property Let customerCountry(value As String)
cCountry = value
End Property
Public Property Get customerStreet() As String
customerStreet = cStreet
End Property
Public Property Let customerStreet(value As String)
cStreet = value
End Property
Public Property Get customerZipcode() As Variant
customerZipcode = cZipcode
End Property
Public Property Let customerZipcode(value As Variant)
cZipcode = value
End Property
Public Property Get customerCity() As String
customerCity = cCity
End Property
Public Property Let customerCity(value As String)
cCity = value
End Property
Public Property Get customerPhoneNum() As Long
customerPhoneNum = cPhoneNum
End Property
Public Property Let customerPhoneNum(value As Long)
cPhoneNum = value
End Property
Public Property Get customerMobileNum() As Long
customerMobileNum = cMobileNum
End Property
Public Property Let customerMobileNum(value As Long)
cMobileNum = value
End Property
Public Property Get customerEmail() As String
customerEmail = cEmail
End Property
Public Property Let customerEmail(value As String)
cEmail = value
End Property
Public Property Get customerInvoiceEmail() As String
customerInvoiceEmail = cInvoiceEmail
End Property
Public Property Let customerInvoiceEmail(value As String)
cInvoiceEmail = value
End Property
Public Property Get customerCreationDate() As Date
customerCreationDate = cCreationDate
End Property
Public Property Let customerCreationDate(value As Date)
cCreationDate = value
End Property
Public Property Get customerLastChange() As Date
customerLastChange = cLastChange
End Property
Public Property Let customerLastChange(value As Date)
cLastChange = value
End Property
Module. "mExtendedCustomerDatabase". Here I collect my customers within the worksheet("CustomerDatabase").
Public CustomerCollection As New Collection
Sub CollectAllCustomers()
Dim tCustomers As clsCustomers
Dim i As Long
Dim wks As Worksheet
Set wks = ThisWorkbook.Worksheets("CustomerDatabase")
For i = 1 To wks.UsedRange.Rows.Count
Set tCustomers = New clsCustomers
With tCustomers
.customerID = "Kunde" & wks.Cells(i, CustomerDatabase.CustomerNumber).value
.customerName = wks.Cells(i, CustomerDatabase.InternRef).value
.customerCompanyName = wks.Cells(i, CustomerDatabase.CompanyName).value
.customerFullName = wks.Cells(i, CustomerDatabase.FirstName).value & wks.Cells(i, CustomerDatabase.LastName).value
.customerCVR = wks.Cells(i, CustomerDatabase.CVR).value
.customerType = wks.Cells(i, CustomerDatabase.customerType).value
.customerGroup = wks.Cells(i, CustomerDatabase.customerGroup).value
.customerCountry = wks.Cells(i, CustomerDatabase.Country).value
.customerStreet = wks.Cells(i, CustomerDatabase.Street).value
.customerZipcode = wks.Cells(i, CustomerDatabase.Zipcode).value
.customerCity = wks.Cells(i, CustomerDatabase.City).value
.customerPhoneNum = wks.Cells(i, CustomerDatabase.PhoneNum).value
.customerMobileNum = wks.Cells(i, CustomerDatabase.MobileNum).value
.customerEmail = wks.Cells(i, CustomerDatabase.Email).value
.customerInvoiceEmail = wks.Cells(i, CustomerDatabase.InvoiceEmail).value
.customerCreationDate = wks.Cells(i, CustomerDatabase.CreationDate).value
.customerLastChange = wks.Cells(i, CustomerDatabase.LastChangeDate).value
CustomerCollection.Add tCustomers, .customerID
End With
Next i
End Sub
Module. "mExtendedCustomerDatabase". Here I'd like to add my whole collection to my ListBox.
Sub FillListBox(sListName As String)
Dim wks As Worksheet
Set wks = ThisWorkbook.Worksheets("CustomerDatabase")
With frm_T1_Kundeoplysninger.Controls.Item(sListName)
.AddItem CustomerCollection.Item("Kunde1") 'Type Mismatch-error
End With
End Sub
To summarize. I'd like some guidelines on the easiest/fastest way to retrieve all items within my collection, and past them into my ListBox. Alternatives ways to do this, are accommodated aswell.
回答1:
I manage to solve it. Converting my collection to an array, and setting my collection as inputparameter. Looping through my entire collection, and allocating it in an array. The issue seems to be related to .List-function, only allowing arrays as variant-datatype. It was solved; inspired by (http://www.iwebthereforeiam.com/iwebthereforeiam/2004/06/excel-vba-code-to-convert-coll.html).
Sub FillListBox(sListName As String)
With frm_T1_Kundeoplysninger.Controls.Item(sListName)
.List = ConvertCollectionToArray(CustomerCollection)
End With
Clearing:
Set CustomerCollection = Nothing
End Sub
Function ConvertCollectionToArray(cCustomers As Collection) As Variant()
Dim arrCustomers() As Variant: ReDim arrCustomers(0 To cCustomers.Count - 1, 16)
Dim i As Integer
With cCustomers
For i = 1 To .Count
arrCustomers(i - 1, 0) = .Item(i).customerID
arrCustomers(i - 1, 1) = .Item(i).customerName
arrCustomers(i - 1, 2) = .Item(i).customerCompanyName
arrCustomers(i - 1, 3) = .Item(i).customerFullName
arrCustomers(i - 1, 4) = .Item(i).customerCVR
arrCustomers(i - 1, 5) = .Item(i).customerType
arrCustomers(i - 1, 6) = .Item(i).customerGroup
arrCustomers(i - 1, 7) = .Item(i).customerCountry
arrCustomers(i - 1, 8) = .Item(i).customerStreet
arrCustomers(i - 1, 9) = .Item(i).customerZipcode
arrCustomers(i - 1, 10) = .Item(i).customerCity
arrCustomers(i - 1, 11) = .Item(i).customerPhoneNum
arrCustomers(i - 1, 12) = .Item(i).customerMobileNum
arrCustomers(i - 1, 13) = .Item(i).customerEmail
arrCustomers(i - 1, 14) = .Item(i).customerInvoiceEmail
arrCustomers(i - 1, 15) = .Item(i).customerCreationDate
arrCustomers(i - 1, 16) = .Item(i).customerLastChange
Next
End With
ConvertCollectionToArray = arrCustomers
End Function
来源：https://stackoverflow.com/questions/21583206/retrieve-items-in-collection-excel-vba