In dit artikel halen we gegevens uit een gesloten werkmap naar de keuzelijst in gebruikersvorm met behulp van VBA.
De onbewerkte gegevens voor dit voorbeeld bevinden zich in het bereik A2:B10 in de werkmap "23SampleData.xls", die is geplaatst in het bestandspad "D:\Excelforum\ExcelForum office\excel tip old code\Shared Macro\23\".
We hebben twee opdrachtknoppen op het hoofdwerkblad gemaakt voor het uitvoeren van twee verschillende gebruikersformulieren. Elke opdrachtknop is gekoppeld aan verschillende gebruikersformulieren.
Logische uitleg
In dit voorbeeld worden twee verschillende manieren gebruikt om gegevens uit de gesloten werkmap op te halen. Dit zijn:-
-
Open de gesloten werkmap en verkrijg de gegevens
-
ADODB-verbinding gebruiken
Open de gesloten werkmap en verkrijg de gegevens
Het is mogelijk om de eigenschap RowSource van een ListBox-besturingselement in te stellen om gegevens uit een andere werkmap op te halen door als volgt waarde toe te wijzen aan de eigenschap RowSource:
‘[Bestandsnaam.xls]Blad1?!$B$1:$B$15
ListBox Control geeft alleen waarden weer als de andere werkmap is geopend.
Dus om de gegevens uit een gesloten werkmap op te halen, zullen we een macro maken om de andere werkmap te openen zonder dat de gebruiker het merkt en gegevens uit de werkmap ophalen om items in de keuzelijst toe te voegen en de werkmap te sluiten.
Als u op de knop "Selecteren" klikt, wordt het gebruikersformulier "UserForm1" geactiveerd. Initialisatiegebeurtenis van het gebruikersformulier wordt gebruikt voor het toevoegen van items in de keuzelijst. Deze gebeurtenis opent eerst de gesloten werkmap en wijst vervolgens de waarde in het bereik toe aan de variant "ListItems". Nadat de waarde is toegewezen, wordt de werkmap gesloten en worden items toegevoegd aan de keuzelijst.
Keuzelijst wordt gebruikt om een naam te selecteren uit de bestaande lijstwaarden. Als u op de knop "OK" drukt, wordt de geselecteerde naam weergegeven.
ADODB-verbinding gebruiken
ActiveX Data Objects (ADO) is een gebruiksvriendelijke interface op hoog niveau voor OLE DB-verbinding. Het is een programmeerinterface om toegang te krijgen tot gegevens in een database en deze te manipuleren.
Om een ADODB-verbinding te maken, moeten we de ADO-bibliotheek aan het project toevoegen.
Kies uit het menu Extra > Referentie om referentie toe te voegen.
Als u op de knop "ADODB-verbinding" op het werkblad klikt, wordt het gebruikersformulier "UFADODB" geactiveerd. In het geval van initialisatie van dit gebruikersformulier hebben we een ADODB-verbinding gebruikt om gegevens op te halen uit de gesloten werkmap. We hebben een aangepaste door de gebruiker gedefinieerde functie (UDF) "ReadDataFromWorkbook" gemaakt om de verbinding tot stand te brengen en de gegevens van de gesloten werkmap naar de array te halen.
We hebben een andere UDF "FillListBox" gebruikt om items toe te voegen aan de List-box tijdens de initialisatie van het gebruikersformulier. Keuzelijst geeft gegevens weer in twee kolommen, één kolom bevat de naam en de tweede kolom bevat de leeftijd.
Als u op de knop "OK" drukt nadat u het item in de lijst hebt geselecteerd, wordt het informatiebericht over het geselecteerde item weergegeven.
Volg hieronder voor de code:
Optie Explicit Sub running() UserForm1.Show End Sub Sub ADODBrunning() UFADODB.Show End Sub 'Voeg onderstaande code toe in UFADODB userform Optie Explicit Private Sub CommandButton1_Click() Dim name1 As String Dim age1 As Integer Dim i As Integer 'Wijs de geselecteerde waarde in keuzelijst naar variabele naam1 en leeftijd1 For i = 0 Naar ListBox1.ListCount - 1 If ListBox1.Selected(i) Then name1 = ListBox1.Value age1 = ListBox1.List(ListBox1.ListIndex, 1) Exit For End If Next ' Maak het gebruikersformulier leeg Unload Me 'Uitvoer weergeven MsgBox "Je hebt " & naam1 & " geselecteerd. Zijn leeftijd is " & leeftijd1 & " jaar." End Sub Private Sub UserForm_Initialize() 'Lijstbox1 vullen met gegevens uit een gesloten werkmap Dim tArray As Variant' Functie ReadDataFromWorkbook aanroepen om gegevens van gespecificeerd bereik naar array te krijgen 'Wijzig pad volgens uw vereiste, "Sample_data" wordt gedefinieerd bereik genoemd tArray = ReadDataFromWorkbook ("D:\Excelforum\ExcelForum office\excel tip oude code\Shared Macro\23\23SampleData.xls", "Sample_Data") 'Oproepfunctie FillListBox voor het toevoegen van items in List Box 'Wijs List box object en tarray toe als parameter FillListBox Me .ListBox1, tArray 'Arrayvariabelen vrijgeven en de toewijzing van geheugen voor hun elementen ongedaan maken. Wis tArray End Sub Private Sub FillListBox (lb As MSForms.ListBox, RecordSetArray As Variant) 'Filling List box lb met gegevens van RecordSetArray Dim r As Long, c As Long With lb .Clear 'Waarde toewijzen aan listbox For r = LBound(RecordSetArray , 2) To UBound(RecordSetArray, 2) .AddItem For c = LBound(RecordSetArray, 1) To UBound(RecordSetArray, 1) .List(r, c) = RecordSetArray(c, r) Volgende c Volgende r 'Geen item selecteren standaard in de keuzelijst .ListIndex = -1 End With End Sub Private Function ReadDataFromWorkbook(SourceFile As String, _ SourceRange As String) As Variant ' vereist een verwijzing naar de Microsoft ActiveX Data Objects-bibliotheek ' (menu Tools > References in de VBE ) Dim dbConnection As ADODB.Connection, rs As ADODB.Recordset Dim dbConnectionString As String 'Het aangeven van een verbindingsreeks en de driver die nodig is voor het tot stand brengen van een verbinding dbConnectionString = "DRIVER={Microsoft Excel Driver (*.xls)};ReadOnly=1;DBQ =" & SourceFile 'Een nieuwe ADODB-verbinding maken Set dbConnection = Nieuwe ADODB.Connection On Error GoTo InvalidInput 'Open de databaseverbinding dbConnection.Open dbConnectionString 'De recordset ophalen uit het gedefinieerde benoemde bereik Set rs = dbConnection.Execute("[" & SourceRange & "]") On Error GoTo 0 'Retourneert een twee dimensionale array met alle records in rs ReadDataFromWorkbook = rs.GetRows 'Sluit de recordset en databaseverbinding rs.Close dbConnection.Close Set rs = Nothing Set dbConnection = Nothing Exit Function 'Code voor het afhandelen van fout InvalidInput: MsgBox "Het bronbestand of het bronbereik is ongeldig!", _ vbExclamation, "Get data from closed workbook" End Function 'Voeg onderstaande code toe in UserForm1 Option Explicit Private Sub CommandButton1_Click() Dim name1 As String Dim i As Integer 'Wijs de geselecteerde waarde toe aan variabele name1 For i = 0 Naar ListBox1.ListCount - 1 If ListBox1.Selected(i) Then name1 = ListBox1.Value Exit For End If Next 'Ontlaad het gebruikersformulier Unload Me 'Toon de geselecteerde naam MsgBox "U hebt " & naam1 & " geselecteerd." End Sub Private Sub UserForm_Initialize() Dim ListItems As Variant, i As Integer Dim SourceWB As Workbook 'Schermupdates uitschakelen Application.ScreenUpdating = False With Me.ListBox1 'Bestaande items uit de listbox verwijderen .Clear 'Open de bronwerkmap als ReadOnly Set SourceWB = Workbooks.Open("D:\Excelforum\ExcelForum office\excel tip old code\Shared Macro\23\23SampleData.xls", _ False, True) 'Verkrijg het gewenste bereik van waarden ListItems = SourceWB.Worksheets(1 ).Range("A2:A10").Value 'Sluit de bronwerkmap zonder wijzigingen op te slaan SourceWB.Close False Set SourceWB = Nothing Application.ScreenUpdating = True 'Converteer waarden naar een verticale array ListItems = Application.WorksheetFunction.Transpose(ListItems) For i = 1 To UBound(ListItems) 'Vul de listbox .AddItem ListItems(i) Next i 'Selecteer standaard geen items, stel in op 0 om het eerste item te selecteren .ListIndex = -1 End With End Sub
Als je deze blog leuk vond, deel hem dan met je vrienden op Facebook. Ook kunt u ons volgen op Twitter en Facebook.
We horen graag van u, laat ons weten hoe we ons werk kunnen verbeteren en voor u kunnen verbeteren. Schrijf ons op de e-mailsite