MS Excel - Userform
- Splash formulier
- Navigeren in tabel
- Combobox Array
- Combobox AddItem
- Combobox benoemde Range
- Combobox Array
- Combobox ListObject
- ListObject afhankelijk Combobox
Splash formulier.
Een pop-up formulier frmSplash die na een aantal seconden wordt afgesloten.
Er wordt ook een knop cmdAfsluiten voorzien die het mogelijk maakt om het formulier sneller te sluiten.
'Knop om formulier sneller af te sluiten
Private Sub cmdSluiten_Click()
Unload frmSplash
End Sub
''Voorzie volgende code vb in Activate_event van Worksheet of Workbook
Private Sub Worksheet_Activate()
frmSplash.Show
End Sub
Voorzie volgende in het Activate_event van het formulier
Private Sub UserForm_Activate()
Dim lngSeconden As Long
Me.Repaint 'Zodoende worden labels en andere zichtbaar.
lngSeconden = Timer()
Do
DoEvents 'hierdoor kan code cmdSluiten_Click worden uitgevoerd
Loop Until (Timer() - lngSeconden) > 7 ''formulier sluit na 7 seconden
Unload Me
End Sub
Top
Navigeren doorheen tabel gegevens met ListObject
Som kan het handig zijn om tabelgegevens via een formulier te
bekijken. Ook gegevens invoeren kan voordelen hebben naar integriteit van de data.
Hier maken wij gebruik van twee eenvoudige tabel namelijkl tblAgent, deze tabel heeft twee velden:
- Naam
- Regio
en de tabel tblRegio met een veld:
- Regio
Wij ontwerpen een Userform frmAgent met de volgende controle-elementen en instellingen:
- formulier Caption : Agent
- tekstvak: txtAgent
- combobox: cboRegio
- label: lblLinks met caption ""
- label lblRechts met caption ""
- spinButton: spbNavigeer
- commandbutton: cmdBewaar
Bij het activeren van het formulier voorzien wij code die de volgende acties verwezenlijkt:
- De RijBron, RowSource van combobox cboRegio koppelen wij aan tabel tblRegio
- Wij tonen de waarden van de eerste rij van tblAgent
in tekstvak txtAgent en combobox cboRegio - De caption van lblLinks zetten wij op 1
betekent dat wij op het eerste record zitten - De caption van lblRechts zetten wij op het maximum aantal rijen of records
Daartoe voorzien wij volgende code in het Activate event van het formulier.
Private Sub UserForm_Activate()
Dim wshData As Worksheet
Dim lsoAgent As ListObject
Dim lsoRegio As ListObject
Set wshData = ThisWorkbook.Worksheets("Data")
Set lsoAgent = wshData.ListObjects("tblAgent")
Set lsoRegio = wshData.ListObjects("tblRegio")
Me.cboRegio.RowSource = lsoRegio.DataBodyRange.Address
Me.lblRechts.Caption = lsoAgent.DataBodyRange.Rows.Count
Me.lblLinks.Caption = 1
Me.txtAgent.Value = lsoAgent.DataBodyRange.Cells(1, 1).Value
Me.cboRegio.Value = lsoAgent.DataBodyRange.Cells(1, 2).Value
End Sub
In de module van het formulier voorzien wij een algemene routine die de waarden van txtAgent en cboRegio zet op basis van de rij in de tabel tblAgent.
Public Sub sNavigeer(intRij As Integer)
Dim wshData As Worksheet
Dim lsoAgent As ListObject
Dim lsoRegio As ListObject
Set wshData = ThisWorkbook.Worksheets("Data")
Set lsoAgent = wshData.ListObjects("tblAgent")
Set lsoRegio = wshData.ListObjects("tblRegio")
Me.txtAgent.Value = lsoAgent.DataBodyRange.Cells(intRij, 1).Value
Me.cboRegio.Value = lsoAgent.DataBodyRange.Cells(intRij, 2).Value
End Sub
Tenslotte roepen wij bovenstaande routine aan in de SpinDown en SpinUp procedures van spbNavigeer.
Private Sub spbNavigeer_SpinDown()
Dim intRij As Integer
If CInt(Me.lblLinks.Caption) > 1 Then
Me.lblLinks.Caption = CInt(Me.lblLinks.Caption) - 1
intRij = CInt(Me.lblLinks.Caption)
sNavigeer (intRij)
Me.Repaint
End If
End Sub
Private Sub spbNavigeer_SpinUp()
Dim intRij As Integer
If CInt(Me.lblLinks.Caption) < CInt(Me.lblRechts.Caption) Then
Me.lblLinks.Caption = CInt(Me.lblLinks.Caption) + 1
intRij = CInt(Me.lblLinks.Caption)
sNavigeer (intRij)
Me.Repaint
End If
End Sub
In de commandbutton cmdBewaar voorzien wij code om wijzingen te bewaren.
Private Sub cmdBewaar_Click()
Dim intRij As Integer
Dim wshData As Worksheet
Dim lsoAgent As ListObject
Set wshData = ThisWorkbook.Worksheets("Data")
Set lsoAgent = wshData.ListObjects("tblAgent")
intRij = CInt(Me.lblLinks.Caption)
lsoAgent.DataBodyRange.Cells(intRij, 1).Value = Me.txtAgent.Value
ThisWorkbook.Save
End Sub
Top
Combobox koppelen aan Array
Me.cboGeslacht.List = Array("Vrouw", "Man")
Top
Combobox Items toevoegen met AddItem methode
Volgende code voegt de namen toe aan een Combobox of ListBox
Dim wkb As Excel.Workbook
Dim sht As Excel.Worksheet
Dim strInfo As String
Set wkb = ActiveWorkbook
For Each sht In wkb.Worksheets
Me.lboSheet.AddItem sht.Name
Next
Me.lboSheet.Selected(0) = True
Top
Combobox koppelen aan benoemde Range
Volgende code voegt Items van Range toe aan een Combobox of Listbox
Dim rng As Excel.Range
Dim wrk As Workbook
Dim wsh As Worksheet
Set wrk = Application.ActiveWorkbook
Set wsh = wrk.Worksheets("NaamForm")
wsh.Activate
Set rng = Range(wsh.Names("SchaalEenTien"))
Me.cboSchaal.RowSource = rng.Address
Top
Combobox koppelen aan Tabel of ListObject
Bij volgende code worden de Items geladen door de RowSource property te koppelen aan het adres van het ListObject. Het listobject mag meerdere kolommen hebben zolang men in de instellingen van de Combobox hetzelfde aantal kolommen instelt.
Dim shtData As Worksheet
Dim lsoTijdstip As ListObject
Set shtData = ThisWorkbook.Worksheets("Data")
Set lsoTijdstip = shtData.ListObjects("tblTijdstip")
Me.lboTijdStip.RowSource = lsoTijdstip.DataBodyRange.Address
Top
Combobox koppelen aan Tabel of ListObject
Bij volgende code worden de Items geladen door de RowSource property te koppelen aan het adres van het ListObject. Het listobject mag meerdere kolommen hebben zolang men in de instellingen van de Combobox hetzelfde aantal kolommen instelt.
Dim shtData As Worksheet
Dim lsoTijdstip As ListObject
Set shtData = ThisWorkbook.Worksheets("Data")
Set lsoTijdstip = shtData.ListObjects("tblTijdstip")
Me.lboTijdStip.RowSource = lsoTijdstip.DataBodyRange.Address
Top
Lijstgegevens van een Listbox afhankelijk keuze Combobox.
Stel twee tabellen tblCategorie en tblSubCategorie.
 |
 |
| tblCategorie | tblSubCategorie |
Vervolgens een formulier frmCat met een Combobox cboCategorie en een Listbox lsbSubCat. Bedoeling is dat als in cboCategorie een keuze wordt gemaakt dat in lstSubCat enkel deze SubCategorie getoond wordt met een IDCategorie gelijk aan deze van de de ComboBox.
 |
Het principe bestaat er uit dat wij gedelimiteerde string vormen die via de VBA Split functie in een Array wordt omgezet. Bij het uitlezen van de Array wordt de AddItem methode toegepast en de Waarde van de tweede kolom toegekend.
'functie voor het vormen van de categorie-string
Public Function fCategorie() As String
Dim wshCategorie As Worksheet
Dim lsoCategorie As ListObject
Dim intRijen As Integer
Dim intKolommen As Integer
Dim intTelR As Integer
Dim intTelK As Integer
Dim strTemp As String
Dim strKol2 As String
Set wshCategorie = ThisWorkbook.Worksheets("categorie")
Set lsoCategorie = wshCategorie.ListObjects("tblCategorie")
intRijen = lsoCategorie.DataBodyRange.Rows.Count
intKolommen = lsoCategorie.DataBodyRange.Columns.Count
For intTelR = 1 To intRijen
strTemp = strTemp & lsoCategorie.DataBodyRange.Cells(intTelR, 1) & ","
Next intTelR
For intTelR = 1 To intRijen
strKol2 = strKol2 & lsoCategorie.DataBodyRange.Cells(intTelR, 2) & ","
Next intTelR
strTemp = Left(strTemp, Len(strTemp) - 1)
strKol2 = Left(strKol2, Len(strKol2) - 1)
fCategorie = strTemp & "|" & strKol2 End Function
'functie voor het vormen van de subcategorie-string
Public Function fFilterOpCategorie(intCat As Integer) As String
Dim wshSubCategorie As Worksheet
Dim lsoSubCategorie As ListObject
Dim strKolIDSub As String
Dim strKolSub As String
Dim intRijen As Integer
Dim intTel As Integer
Set wshSubCategorie = ThisWorkbook.Worksheets("subcategorie")
Set lsoSubCategorie = wshSubCategorie.ListObjects("tblSubCategorie")
intRijen = lsoSubCategorie.DataBodyRange.Rows.Count
For intTel = 1 To intRijen
'Debug.Print lsoSubCategorie.DataBodyRange.Cells(intTel, 1)
If Int(lsoSubCategorie.DataBodyRange.Cells(intTel, 0).Value) = intCat Then
strKolIDSub = strKolIDSub & lsoSubCategorie.DataBodyRange.Cells(intTel, 1) & ","
strKolSub = strKolSub & lsoSubCategorie.DataBodyRange.Cells(intTel, 2) & ","
End If
Next
If Len(strKolIDSub) <> 0 Then
strKolIDSub = Left(strKolIDSub, Len(strKolIDSub) - 1)
strKolSub = Left(strKolSub, Len(strKolSub) - 1)
fFilterOpCategorie = strKolIDSub & "|" & strKolSub
Else
fFilterOpCategorie = ""
End If
End Function
'In de Activate-event van het formulier wordt de categorie string
in de ComboBox cbocategorie ingelezen
Private Sub UserForm_Activate()
Dim intTel As Integer
Dim aTotaal() As String
Dim aKol1() As String
Dim aKol2() As String
aTotaal = Split(fCategorie, "|")
aKol1 = Split(aTotaal(0), ",")
aKol2 = Split(aTotaal(1), ",")
For intTel = 0 To 4
Me.cboCategorie.AddItem aKol1(intTel)
Me.cboCategorie.Column(1, intTel) = aKol2(intTel)
Next
Me.cboCategorie.DropDown
End Sub
'In de Change-event van cboCategorie wordt de string van de subCategorie
'in de Listbox lsbsubCat ingelezen
Private Sub cboCategorie_Change()
Dim aTotaal() As String
Dim aKol1() As String
Dim aKol2() As String
Dim intIDCat As Integer
Dim intTel As Integer
Me.lsbSubCat.Clear
If Len(Me.cboCategorie.Value) > 0 Then
intIDCat = CInt(Me.cboCategorie.Value)
If Len(fFilterOpCategorie(intIDCat)) <> 0 Then
aTotaal = Split(fFilterOpCategorie(intIDCat), "|")
aKol1 = Split(aTotaal(0), ",")
aKol2 = Split(aTotaal(1), ",")
For intTel = 0 To UBound(aKol1)
Me.lsbSubCat.AddItem aKol1(intTel)
Me.lsbSubCat.Column(1, intTel) = aKol2(intTel)
Next intTel
End If
End If
Me.Repaint
End Sub
Top
hallo