Извлечение элементов в коллекции (Excel, VBA)

Я получаю ошибку несоответствия типа при попытке получить элементы из моей коллекции.Извлечение элементов в коллекции (Excel, VBA)

Что я в основном хочу сделать, это собрать всех клиентов в виде коллекции и проделать все результаты в моем ListBox для визуализации. Причина, по которой я использую модуль класса, связана с тем, что UDT вставляет ошибку: «Только пользовательские типы, определенные в публичных объектных модулях, могут быть принудительно применены к варианту или из варианта или переданы в функции с поздними ограничениями ». Поэтому я начал программировать все свойства в классах, но раньше я не работал с классами, поэтому для меня это очень ново.

У меня возникла другая проблема; свойство .additem ограничено 9 столбцами (в ListBox), и поэтому я хотел бы использовать для этого другой метод. Массив неограничен, а ресурсы строк ограничены 256 или 255. Я бы хотел, чтобы в ListBox отображались 14 столбцов, а также возможность расширения при необходимости позже.

ListView на самом деле не вариант из-за того, что на многих компьютерах эта ссылка не интегрирована.

Класс-модуль. "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

Модуль. "MExtendedCustomerDatabase". Здесь я собираю своих клиентов на листе (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

Модуль. "MExtendedCustomerDatabase". Здесь я хотел бы добавить всю свою коллекцию в свой 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

Подводя итоги. Я бы хотел, чтобы некоторые рекомендации касались самого простого/быстрого способа извлечения всех элементов в моей коллекции и мимо них в моем ListBox. Альтернативные способы сделать это также учитываются.

источник

2014-02-05 Unicco

VBA не работает, как некоторые другие платформы (например NET), где вы можете с радостью назначить объект элементам управления пользовательским интерфейсом. 'AddItem()' принимает строку как первый параметр, а не объект. Вам нужно «вручную» заполнить список, явно кодируя различные значения столбцов. –

Я не уверен, что полностью понимаю вас - как я могу добавить элементы коллекции? Не могли бы вы объяснить это по-другому, пример кодирования или, возможно, ссылку, которая объясняет это? – Unicco

См. Ответ «Крис» здесь: http://stackoverflow.com/questions/8689812/identify-and-populate-a-listbox –

Мне это удалось. Преобразование моей коллекции в массив и установка моей коллекции в качестве входного параметра. Цикл через всю мою коллекцию и выделение ее в массиве. Эта проблема, похоже, связана с .List-функцией, только разрешая массивы как вариант-тип данных. Он был решен; вдохновленный (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

источник

2014-02-06 11:08:56 Unicco

Извлечение элементов в коллекции (Excel, VBA)

ответ

Смежные вопросы