Dynamiskt addera poster till en Listbox


Här demonstreras ett sätt att dynamiskt lägga till poster till en Listbox i ett formulär. Självklart kan tipset även användas i Excel utan att involvera en Access-databas.

Data skrivs till ett arbetsblad i exemplet. En förutsättning för att visa kolumnanmn (fältnamn) i en Listbox är att vi använder oss av egenskapen RowSource för Listboxen.

I exemplet används ADO (ActiveX Data Objects) för import av data till Excel.

Saknas ADO-biblioteket på din dator kan den hämtas från Microsofts databashemsida. Det kan vara aktuellt för dig som använder XL 97 med ett äldre operativsystem än Windows 2000.

Innan proceduren körs måste en referens sättas till ADO:s bibliotek:
Det sker på följande sätt:

1. Öppna VB-Editorn i Excel.

2. Välj kommandot Verktyg | Referenser...

3. Kryssa för Microsoft ActiveX Data Objects x.x Library.

 

Om ett felmeddelande erhålls vid kopiering till VBA-modul så läs mer här»
 

 

(© 2002 - 2004 All rights Colo - Used by permission)

Option Explicit

 

Private Sub UserForm_Initialize()

   '© 2004 Alla rättigheter XL-Dennis

   Dim wbBook As Workbook

   Dim wsSheet As Worksheet

   Dim rnData As Range

   Dim cnt As ADODB.Connection

   Dim rst As ADODB.Recordset

   Dim stDB As String, stSQL As String

   Dim vaData As Variant

   Dim j As Long, x As Long, i As Long, y As Long

   Dim dbWidth As Double

 

   Set wbBook = ThisWorkbook

   Set wsSheet = wbBook.Worksheets(1)

 

   Set cnt = New ADODB.Connection

   Set rst = New ADODB.Recordset

 

   stDB = ThisWorkbook.Path & "\" & "Test.mdb"

   stSQL = "SELECT * FROM tblData"

 

   cnt.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _

         "Data Source=" & stDB & ";"

 

   With rst

      .CursorLocation = adUseClient

      .Open stSQL, cnt, adOpenStatic, adLockReadOnly

      'Här skapar vi disconnected recordset.

      .ActiveConnection = Nothing

      j = .Fields.Count

      i = .RecordCount

   End With

 

   With wsSheet

      .UsedRange.Clear

      'Skriver fältnamnen till första raden i arbetsbladet

      For x = 0 To j - 1

         .Cells(1, x + 1).Value = rst.Fields(x).Name

      Next x

      'Överför all data från recordset.

      .Cells(2, 1).CopyFromRecordset rst

      'Definierar cellområdet som ska bli Listboxens RowSource.

      Set rnData = .Range(.Cells(2, 1), .Cells(i, j))

   End With

 

   'Justerar kolumnbredden vilken vi använder för att dimensionera

   'kolumnbredden i Listbox.

   rnData.Offset(-1, 0).Columns.AutoFit

 

   'Här summerar vi ihop bredden för varja kolumn i cellområdet rnData

   'och lägger till 40 points för att få en tillfredsställande bredd på

   'Listboxen.

   For y = 1 To j

      dbWidth = dbWidth + (rnData(1, y).Columns.Width + 40)

   Next y

 

   With Me.ListBox1

      .BoundColumn = j

      .ColumnCount = j

      .ColumnHeads = True

      .Width = dbWidth

      .RowSource = rnData.Parent.Name & "!" & rnData.Address

      .ListIndex = -1

   End With

 

   rst.Close

   Set rst = Nothing

   cnt.Close

   Set cnt = Nothing

End Sub