I denne artikkelen vil vi hente data fra lukket arbeidsbok til listeboks i brukerform ved hjelp av VBA.
Rådata for dette eksemplet er i område A2: B10 på arbeidsboken “23SampleData.xls”, som er plassert i filbanen “D: \ Excelforum \ ExcelForum office \ excel tip old code \ Shared Macro \ 23 \”.
Vi har laget to kommandoknapper på hovedarket for å kjøre to forskjellige brukerformer. Hver kommandoknapp er knyttet til forskjellige brukerformer.
Logisk forklaring
I dette eksemplet brukes to forskjellige måter for å hente data fra den lukkede arbeidsboken. Disse er:-
-
Åpne den lukkede arbeidsboken og få dataene
-
Bruke ADODB -tilkobling
Åpne den lukkede arbeidsboken og få dataene
Det er mulig å angi RowSource -egenskapen til en ListBox -kontroll for å hente data fra en annen arbeidsbok ved å tilordne verdi til RowSource -egenskapen som følger:
‘[Filnavn.xls] Ark1?! $ B $ 1: $ B $ 15
ListBox Control vil bare vise verdier hvis den andre arbeidsboken er åpen.
Så for å hente dataene fra lukket arbeidsbok, vil vi lage en makro for å åpne den andre arbeidsboken uten at brukeren legger merke til det og hente data fra arbeidsboken for å legge til elementer i listeboksen og lukke arbeidsboken.
Hvis du klikker på "Velg" -knappen, aktiveres brukerformen "UserForm1". Initialiser hendelsen til brukerformen brukes til å legge til elementer i listeboksen. Denne hendelsen åpner først den lukkede arbeidsboken og tildeler deretter verdien i området varianten "ListItems". Etter at verdien er tilordnet, lukkes arbeidsboken og elementer legges til i listeboksen.
Listeboks brukes til å velge navn fra de eksisterende listeverdiene. Trykk på "OK" -knappen for å vise det valgte navnet.
Bruke ADODB -tilkobling
ActiveX Data Objects (ADO) er et brukervennlig grensesnitt på høyt nivå for OLE DB-tilkobling. Det er et programmeringsgrensesnitt for å få tilgang til og manipulere data i en database.
For å opprette ADODB -tilkobling må vi legge til ADO -biblioteket i prosjektet.
For å legge til referanse, velg fra Verktøy -menyen> Referanse.
Hvis du klikker på "ADODB Connection" -knappen i regnearket, aktiveres "UFADODB" brukerform. I initialiseringshendelsen til denne brukerformen har vi brukt ADODB -tilkobling for å hente data fra den lukkede arbeidsboken. Vi har opprettet en tilpasset brukerdefinert funksjon (UDF) "ReadDataFromWorkbook" for å etablere tilkoblingen og hente dataene fra den lukkede arbeidsboken til matrisen.
Vi har brukt en annen UDF "FillListBox" for å legge til elementer i listeboksen under initialisering av brukerformen. Listeboks vil vise data i to kolonner, en kolonne inneholder navnet og den andre kolonnen inneholder alderen.
Hvis du trykker på "OK" -knappen etter at du har valgt elementet i listeboksen, vises informasjonsmeldingen om det valgte elementet.
Følg koden nedenfor
Alternativ Eksplisitt sub kjører () UserForm1.Show End Sub Sub ADODBrunning () UFADODB.Show End Sub 'Legg til kode under UFADODB brukerform Alternativ Explicit Private Sub CommandButton1_Click () Dim name1 As String Dim age1 As Integer Dim i As Integer' Tilordne den valgte verdi i listeboks til variabelnavn1 og alder1 For i = 0 Til ListBox1.ListCount - 1 Hvis ListBox1.Selected (i) Da navn1 = ListBox1.Value age1 = ListBox1.List (ListBox1.ListIndex, 1) Avslutt for slutt hvis neste ' Unload userform Unload Me 'Viser utdata MsgBox "Du har valgt" & name1 & ". Hans alder er" & age1 & "yrs." End Sub Private Sub UserForm_Initialize () 'Filling ListBox1 med data fra en lukket arbeidsbok Dim tArray As Variant' Anropsfunksjon ReadDataFromWorkbook for å få data fra spesifisert område til array 'Endre bane i henhold til kravet ditt, "Sample_data" heter definert område tArray = ReadDataFromWorkbook ("D: \ Excelforum \ ExcelForum office \ excel tip old code \ Shared Macro \ 23 \ 23SampleData.xls", "Sample_Data") 'Anropsfunksjon FillListBox for å legge til elementer i List Box' Assign List box object og tarray som parameter FillListBox Me .ListBox1, tArray 'Frigjør matrisevariabler og fordel minnet som brukes for elementene. Slett tArray End Sub Private Sub FillListBox (lb As MSForms.ListBox, RecordSetArray As Variant) 'Filling List box lb with data from RecordSetArray Dim r As Long, c As Long With lb. Clear' Tildeler verdi til listbox For r = LBound (RecordSetArray , 2) Til UBound (RecordSetArray, 2) .AddItem For c = LBound (RecordSetArray, 1) To UBound (RecordSetArray, 1) .Liste (r, c) = RecordSetArray (c, r) Neste c Neste r 'Velge ingen vare i Liste -boksen som standard .ListIndex = -1 Slutt med slutt Sub Privat funksjon ReadDataFromWorkbook (SourceFile As String, _ SourceRange As String) As Variant 'krever en referanse til biblioteket Microsoft ActiveX Data Objects' (menyverktøy> Referanser i VBE ) Dim dbConnection As ADODB.Connection, rs As ADODB.Recordset Dim dbConnectionString As String 'Deklarere en tilkoblingsstreng og driveren krever for å etablere tilkobling dbConnectionString = "DRIVER = {Microsoft Excel Driver (*.xls)}; ReadOnly = 1; DBQ = "& SourceFile 'Opprette en ny ADODB -tilkobling Sett dbConnection = Ny ADODB.Connection On Error GoTo InvalidInput 'Åpne databasetilkoblingen dbConnection.Open dbConnectionString' Henter platesettet fra definert navngitt område Sett rs = dbConnection.Execute ("[" & SourceRange & "]") On Error GoTo 0 'Returnerer to dimensjonal matrise med alle poster i rs ReadDataFromWorkbook = rs.GetRows 'Lukk rekordsettet og databasetilkoblingen rs.Close dbConnection.Close Set rs = Nothing Set dbConnection = Nothing Exit Function' Kode for håndteringsfeil InvalidInput: MsgBox "Kildefilen eller kildeområdet er ugyldig! ", _ vbExclamation," Hent data fra lukket arbeidsbok "Avslutt funksjon 'Legg til under kode i UserForm1 Alternativ Eksplisitt privat underkommandoButton1_Click () Dim navn1 som streng Dim i som heltall' Tilordne den valgte verdien til variabelnavn1 For i = 0 To ListBox1.ListCount - 1 If ListBox1.Selected (i) Then name1 = ListBox1.Value Exit For End If Next 'Unload the userform Unload Me' Vis det valgte navnet MsgBox "Du har valgt" & name1 & "." End Sub Private Sub UserForm_Initialize () Dim ListItems As Variant, i As Integer Dim SourceWB As Workbook 'Slå skjermoppdateringer av Application.ScreenUpdating = False With Me.ListBox1' Fjern eksisterende oppføringer fra listeboksen. Fjern 'Åpne kilden arbeidsbok som ReadOnly Set SourceWB = Workbooks.Open ("D: \ Excelforum \ ExcelForum office \ excel tip old code \ Shared Macro \ 23 \ 23SampleData.xls", _ False, True) 'Skaff deg verdiområdet du vil ha ListItems = SourceWB.Worksheets (1 ) .Range ("A2: A10"). Verdi 'Lukk kildearbeidsboken uten å lagre endringer SourceWB.Close False Set SourceWB = Nothing Application.ScreenUpdating = True' Konverter verdier til et vertikalt array ListItems = Application.WorksheetFunction.Transpose (ListItems) For i = 1 Til UBound (ListItems) 'Fyll ut listeboksen .AddItem ListItems (i) Neste i' Velg ingen elementer som standard, sett til 0 for å velge det første elementet. ListIndex = -1 End With End Sub
Hvis du likte denne bloggen, del den med vennene dine på Facebook. Du kan også følge oss på Twitter og Facebook.
Vi vil gjerne høre fra deg, gi oss beskjed om hvordan vi kan forbedre arbeidet vårt og gjøre det bedre for deg. Skriv til oss på e -post