MS Access. - Formulier.
- Zilvermeeuw-16
- Access start
- Sluiten
- Is formulier open
- Controle elementen
- Tekstvak
- Verticale tekst
- Kalender
- Combo- en Lijstvakken
- Webbrowser
Functie die alle open formulieren sluit.
Sub SluitAlleF()
Dim intI As Integer
For intI = Forms.Count - 1 To 0 Step -1
DoCmd.Close acForm, Forms(intI).Name
Next intI
End Sub
Is een Formulier open of geladen
'een van de vele functies die nagaat indien een formulier open is.
Function IsFormOpen(strNaamForm As String) As Boolean
On Error Resume Next
Dim strTemp As String
strTemp = Forms(strName).Name
' zal een fout geven indien formulier niet geladen is.
IsFormOpen = (Err.Number <> 0)
End Function
'Nog functie die nagaat indien een form open, hier van Dev Ashish
Function fIsLoaded(ByVal strFormName As String) As Integer
If SysCmd(acSysCmdGetObjectState, acForm, strFormName) <> 0 Then
If Forms(strFormName).CurrentView <> 0 Then
fIsLoaded = True
End If
End If
End Function
Controle Elementen
'soms wil men nagaan indien een control een waarde heeft, of een numerieke waarde heeft
'of wil dynamisch de achtergrond kleur van een control zetten.
'deze functie maakt dit tot een bepaald niveau mogelijk.
'voorzie volgende code in het algemeen gedeelte van een gewone module.
Option Compare Database
Option Explicit
Public Const avVeldWaardeVereist As Integer = 1
Public Const avVeldNumeriek As Integer = 2
Public Const avVeldDatum As Integer = 3
Public Const avVeldDisable As Integer = 4
Public Const avVeldEnable As Integer = 5
Public Const avBGKleur As Integer = 6
Public Const avBGKleurTerug As Integer = 7
Public Const avBlanken As Integer = 8
'gebruik:
'If fCtlToest(Me.Name, Array("txtWat", "cboNaam1", "txtWat2", "cboNaam2",_
"txtWat3", "txtWat4"), avVeldWaardeVereist) Then
'bij True is de controle OK
Public Function fCtlToest(strForm As String, aCtls As Variant, intWat As Integer) As Boolean
Dim frm As Access.Form
Dim ctl As Access.Control
Dim lngTel As Long
Dim lngOnder As Long
Dim lngBoven As Long
lngOnder = LBound(aCtls)
lngBoven = UBound(aCtls)
Set frm = Access.Forms(strForm)
For lngTel = lngOnder To lngBoven
For Each ctl In frm.Controls
If ctl.Name = aCtls(lngTel) Then
Select Case intWat
Case 1
If (IsNull(ctl)) Or (Len(ctl) = 0) Then
MsgBox "Alle gele velden moeten geselecteerd zijn!" & vbCrLf & "en een waarde hebben!",_
vbCritical + vbInformation, cToep
fCtlToest = False
Exit Function
End If
Case 2
If Not IsNumeric(ctl) Then
MsgBox "Veld moet numerieke waarde hebben!", vbCritical + vbInformation, cToep
fCtlToest = False
Exit Function
End If
Case 3
If Not IsDate(ctl) Then
MsgBox "Veld moet datum waarde hebben!", vbCritical + vbInformation, cToep
fCtlToest = False
Exit Function
End If
Case 4
ctl.Enabled = False
Case 5
ctl.Enabled = True
Case 6
ctl.BackColor = vbYellow
Case 7
ctl.BackColor = 12632256
Case 8
ctl = ""
End Select
End If
Next
Next
fCtlToest = True
End Function
Tekstvak
Overdracht waarden Tekstvakken.
'Op formulieren waarbij hoofdzakelijk data ingegeven wordt komt
het veel voor dat de gegevens
in de tekstvakken herhaald worden maw gelijk zijn aan deze van het vorige record. Door de standaard-waarde van het tekstveld,
via de afterupdate-gebeurtenis, in te stellen op de huidige waarde kan men dit process vergemakkelijken.
Hier de code voor "tekstwaarde", "numerieke waarden" en datum waarde.
'Tekstwaarde of string, de functie Chr(39) retourneert een '
Private Sub txtString_AfterUpdate()
Me.txtString.DefaultValue = Chr(39) & Me.txtString.Value & Chr(39)
End Sub
'Numerieke waarde
Private Sub txtNumeriek_AfterUpdate()
Me.txtNumeriek.DefaultValue = Me.txtNumeriek.Value
End Sub
'Datum waarde, de functie Chr(35) retourneert een #
Private Sub txtDatum_AfterUpdate()
Me.txtDatum.DefaultValue = Chr(35) & Me.txtDatum & Chr(35)
End Sub
Tekst in een label of tekstvak verticaal schikken.
'met deze functie kan men in Access tekst verticaal schikken
'deze functie is afkomstig van Günther Ritter gritter@gmx.de
Public Function Vertic(str As String, blnHoofdL As Boolean) As String
Dim n As Long, i As Long, st As String, varAsc As Byte
n = Len(str)
For i = 1 To n
st = Mid$(str, i, 1)
varAsc = Asc(st)
If i < n Then
If varGross = True Then
If (varAsc > 96 And varAsc < 123) Or varAsc = 228
Or varAsc = 246 Or varAsc = 252 Then
Vertic = Vertic & UCase$(st) & vbCrLf 'gross schreiben
> Else
Vertic = Vertic & st & vbCrLf
End If
Else
Vertic = Vertic & st & vbCrLf
End If
Else
If blnHoofdL = True Then
If (varAsc > 96 And varAsc < 123) Or varAsc = 228
Or varAsc = 246 Or varAsc = 252 Then
Vertic = Vertic & UCase$(st) 'gross schreiben
Else
Vertic = Vertic & st
End If
Else
Vertic = Vertic & st
End If
End If
Next
End Function
Kalender formulier
Een formulier waar men afhankelijk van de keuze van het Jaartal en de Maand een overzicht van de
betreffende dagen krijgt.
Voorzie vier tabellen :
- tblDag : één veld Dag als primaire sleutel van het type Byt met 31 records voor alle dagen.
- tblMaand : één veld Maand primaire sleutel Byt met slechts één record namelijk de betrokken maand.
De maand wordt gekozen aan de hand van een combo die als rijbron tblLuMaand heeft. - tblLuMaand : twee velden Maand als primaire sleutel van het type Byt (van 1 tot 12) en Veld Naam van het type Tekst van (Januari tot December).
- tblJaar : één veld Jaar als primaire sleutel van het type Integer met slechts één record namelijk het betrokken jaar.
Verder moet men drie Queries voorzien.
- qselGenerDatum van de 3 tabellen tblDag,tblMaand,tblJaar als Cartesiaans product.
SELECT DateSerial([Jaar],[Maand],[dag]) AS Datum, IsDate([dag] & "/" & [Maand] & "/" & [Jaar]) AS GeldigeDatum
FROM tblDag, tblJaar, tblMaand
WHERE (((IsDate([dag] & "/" & [Maand] & "/" & [Jaar]))=True))
ORDER BY DateSerial([Jaar],[Maand],[dag]); - Een aggregatie query die van de specifieke toepassingstabel aggregeert op het veld datum,
qagDatSel. Stel bijvoorbeeld dat de specifieke toepassingstabel tblLog is :
SELECT tblLog.Datum
FROM tblLog
GROUP BY tblLog.Datum; - qselGenerDatum1 , select query van qselGenerDatum en qagDatSel met een left outer join op veld datum.
SELECT qselGenerDatum.Datum, f_Weekdag([qselGenerDatum.datum]) AS Dag, qagDatSel.Datum AS Notitie
Deze query geeft alle dagen van betrokken maand en op het veld datum van de aggregatie query enkel de data die in de toepassingstabel voor komen.
FROM qselGenerDatum LEFT JOIN qagDatSel ON qselGenerDatum.Datum = qagDatSel.Datum;
Verder moet men twee formulieren ontwerpen.
-
Een formukier frmKalender zonder recordsource met :
één tekstveld ongebonden txtJaar met er naast twee knopen cmdPlus en cmdMin
één ongebonden combo cboMaand met rijbron SELECT tblMaandLu.Maand, tblMaandLu.Naam FROM tblMaandLu ORDER BY tblMaandLu.Maand; twee kolommen 1 verborgen (maand) en één zichtbaar Naam (van de maand). - Een formulier sfrDag type doorlopend met recordsource qselGenerDatum1
één knop cmdGa
drie velden txtDatum en txtDag en onzichtbaar veld txtNotitie
een conditional format in de eerste twee velden len(txtNotitie)> 0 een ander kleur geven.
Dit formulier is het bronobject voor een subformulier subDag op het formulier frmKalender.
Tenslotte is er nog de code, er is een module basKalender en vervolgens de code ingekapseld binnen de bovenvermelde formulieren.
- De module basKalender heeft twee functies:
- de functie bb_AanpJM
- de functie f_Weekdag
Public Function bb_AanpJM(intJaar As Integer, bytMaand As Byte) as Boolean Dim db As DAO.Database Dim strVerwijdJaar As String Dim strVerwijdMaand As String Dim strToevJaar As String Dim strToevMaand As String bb_AanpJM = False strVerwijdJaar = "DELETE * FROM tblJaar;" strVerwijdMaand = "DELETE * FROM tblMaand;" strToevJaar = "INSERT INTO tblJaar (Jaar) VALUES (" & intJaar & ");" strToevMaand = "INSERT INTO tblMaand (MAAND) VALUES (" & bytMaand & ");" Set db = CurrentDb db.Execute strVerwijdJaar db.Execute strVerwijdMaand db.Execute strToevJaar db.Execute strToevMaand bb_AanpJM = True On Error Resume Next db.Close Set db = Nothing End Function
Public Function f_Weekdag(datDatum As Date) As String Dim bytdag As Byte datDatum = Format(datDatum, "dd,mm,yyyy") bytdag = Weekday(datDatum) Select Case bytdag Case 1: f_Weekdag = "Zondag" Case 2: f_Weekdag = "Maandag" Case 3: f_Weekdag = "Dinsdag" Case 4: f_Weekdag = "Woensdag" Case 5: f_Weekdag = "Donderdag" Case 6: f_Weekdag = "Vrijdag" Case 7: f_Weekdag = "Zaterdag" End Select End Function - De code achter formulier frmKalender:
Private Sub sBlanken() Dim db As DAO.Database Set db = CurrentDb db.Execute "DELETE * FROM tblDatumSel;" Me.subDatumSel.Requery End Sub
Private Sub cboMaand_AfterUpdate() Me.txtJaar.SetFocus If bb_AanpJM(Me.txtJaar, Me.cboMaand) Then '' functie in basKalender Me.subDag.Requery Call sBlanken End If End Sub
Private Sub cmdMin_Click() Dim intJaar As Integer intJaar = CInt(Me.txtJaar) Me.txtJaar = intJaar - 1 If bb_AanpJM(Me.txtJaar, Me.cboMaand) Then Me.subDag.Requery Call sBlanken End If End Sub
Private Sub cmdPlus_Click() Dim intJaar As Integer intJaar = CInt(Me.txtJaar) Me.txtJaar = intJaar + 1 If bb_AanpJM(Me.txtJaar, Me.cboMaand) Then Me.subDag.Requery Call sBlanken End If End Sub
Private Sub Form_Open(Cancel As Integer) Me.txtJaar = Year(Date) Me.cboMaand = Month(Date) If bb_AanpJM(Me.txtJaar, Me.cboMaand) Then Me.subDag.Requery Call sBlanken End If End Sub
Combo- en Lijstvakken.
Navigeren naar een record.
'Deze code is oorspronkelijk afkomstig van Allen Browne.
Ik heb deze code met succes toegepast op formulieren die gebonden waren aan 5000 records.
In de hoofdsessie (header) van een formulier die een tabel of query als bron (recordsource) heeft, voorziet met een ongebonden Combobox
, 'cboZoek', die als rijbron (rowsource) het op te zoeken veld heeft. In de Afterupdate event van de combobox voorziet men volgende code.
'Het te zoeken veld heeft een numerieke waarde Private Sub cboZoek_AfterUpdate() Dim lngTeZoeken As long Dim rstZoek As DAO.recordset lngTeZoeken = Me.cboZoek set rstZoek = Me.RecordsetClone rstZoek.FindFirst "IDPersoon = " & lngTeZoeken If Not rstZoek.NoMatch Then Me.Bookmark = rstZoek.Bookmark End If Set rstZoek = Nothing End Sub
'' Het te zoeken veld heeft een String waarde Private Sub cboZoek_AfterUpdate() Dim strTeZoeken As string Dim rstZoek As DAO.recordset strTeZoeken = Me.cboZoek set rstZoek = Me.RecordsetClone rstZoek.FindFirst "strPersoon = """ & strTeZoeken & """" If Not rstZoek.NoMatch Then Me.Bookmark = rstZoek.Bookmark End If Set rstZoek = Nothing End Sub
Data weergeven op basis van de waarden van een Jaar en Maand combo.
Maak een module met volgende functie
Public Function fcbo_J_M(cboJ As ComboBox, cboM As ComboBox, strBron As String) As String
'strBron is gebaseerd op een query waar naast de specieke velden
'de velden Datum, Jaar en Maand aanwezig zijn.
Dim strBronForm As String
Dim intMaand As Integer
Dim intJaar As Integer
intMaand = cboM.Value
intJaar = cboJ.Value
strBronForm = "SELECT * FROM " & strBron & " WHERE Jaar = " & intJaar & " AND Maand = " & intMaand & " ORDER BY Datum;"
fcbo_J_M = strBronForm
End Function
Op het formulier die de gefilterde data moet weergeven, voorzie in de hoofd- of voetsectie
twee comboboxen, cboJaar en cboMaand, deze hebben als rijbron respectievelijk jaartallen en de maanden van
1 tot en met 12.
Voorzie in het afterupdate-event van zowel cboJaar als cboMaand de volgende code.
Private Sub cboJaar_AfterUpdate()
Dim strBronForm As String
Dim rst As DAO.Recordset
strBronForm = fcbo_J_M(Me.cboJaar, Me.cboMaand, "qselLog")
Me.RecordSource = strBronForm
Me.Refresh
Set rst = Me.RecordsetClone
If rst.RecordCount = 0 Then
MsgBox "Geen records gevonden", vbOKOnly, "Opgepast"
End If
End Sub
Voorzie in het Open-event van het formulier volgende code zodat de data van het huidig jaar en maand weergegeven worden.
Private Sub Form_Open(Cancel As Integer)
Dim intJaar As Integer
Dim intMaand As Integer
intJaar = fJaar(Date)
intMaand = fMaand(Date)
Me.cboJaar = intJaar
Me.cboMaand = intMaand
Call cboJaar_AfterUpdate
End Sub
Webbrowser controle element
Het Webbrowser controle element, beschikbaar bij de gebruikelijke controle elementen.
A. Een plaatselijk HTML bestand weergevenMen kan de controlebron van het webbrowser controle element koppelen aan een veld van de tabel.
Stel een tabel tblHTMLPlslk met volgende velden:
- ID_HTMLpltslk :
als primaire sleutel - HTMLBest :
Naam van het HTML-bestand, van veldtype text - HTMLInfo :
informatie over het HTML bestand
Wanneer men de controlebron instelt op een veld van de tabel moet naar het volledige pad van het HTML worden verwezen.Het is niet aangewezen dit in de tabel te op te nemen, gezien dit fouten kan geven als HTML bestanden op een andere locatie verplaatst worden.Beter is enkel de naam van het HTML bestand in de tabel te noteren. In een query kan men een berekend veld voorzien van de map van de database en de naam van het HTML bestand.
Wij voorzien een query qselHTMLPlslk met het berekend veld Link. De functie f_GeefMapDb_1 geeft de map van de Access-database waar de naam van het HTML bestand wordt aan toegevoegd.
SELECT tblHTMLPltslk.ID_HTMLpltslk, f_GeefMapDb_1() & [HTMLBest] AS Link, tblHTMLPltslk.HTMLInfo
FROM tblHTMLPltslk;
Kies de query qselHTMLPlslk als bron voor het formulier frmHTMLPlslk, voeg op het formulier een Webbrowser controle element toe, webPlaatselijk, en zet het veld Link van de query als controle bron.
Met de navigatieknoppen gaat men naar de HTML documenten genoteerd is in de tabel en bewaard in dezelfde map als het Access Bestand.
B. Een webpagina weergeven waarvan de URL als link in tabel is opgenomen.
Men kan de controlebron van het webbrowser controle element koppelen aan een veld van de tabel.
Stel een tabel tblWebURL_1 met de volgende velden:
- D_WebURL_1 :
als primaire sleutel ID van de webpagina - URL :
Adres van de webpagina Opgeslagen als link, van veldtype hyperlink - WebInfo :
Informatie over de website
Kies de tabel tblWebURL_1 als bron voor het formulier frmWebURL_1, voeg op het formulier een Webbrowser controle element toe, webURL_1, en zet het veld URL van de tabel als controle bron.
Met de navigatieknoppen gaat men naar webpagina's waarvan de URL als hyperlink genoteerd is in de tabel.
C. Een plaatselijk HTML bestand via Code weergeven door keuze in combobox
Men kan de controlebron van het webbrowser controle element zetten via code hier via de keuze
van een combobox.
Stel een ongebonden formulier frmHTMLcode , op het formulier wordt voorzien :
- een combobox cboKiesHTML
met als rijbron tblHTMLpltslk en als gebonden kolom het veld HTMLBest.
aantal kolommen 3 en
kolombreedten 0;0;5cm - En webbrowser controle element webPlaatsCode
zonder controlebron aan te duiden.
In de afterupdate-gebeurtenis van de combobox cboKiesHTML wordt volgende code voorzien:
In de onOpen gebeurtenis van het formulier frmHTMLCode wordt het eerste lijstelement van de combo gekozen en in de webbrowser het betreffende HTML bestand weergegeven.
D. Een plaatselijk HTML bestand in Array via Code weergeven door keuze in combobox
Toont veel overeenkomst met C hier echter geen tabel maar de bestanden worden genoteerd in een Array strHTMLBest(3):
- Dim strHTMLBest(3) As String
- strHTMLBest(0) = "WebBrow_01.htm"
- strHTMLBest(1) = "WebBrow_02.htm"
- strHTMLBest(2) = "WebBrow_03.htm"
- strHTMLBest(3) = "WebBrow_04.htm"
De Array wordt geïnitialiseerd in de afterUpdate gebeurtenis van de combobox, de combobox zelf krijgt zijn elementen in de onOpen Gebeurtenis van het formulier. Hier de code daarvan :
En hier de code in de afterUpdate gebeurtenis van de combo:
E. Webpagina in Array via Code weergeven door keuze in listbox
Toont veel overeenkomst met B hier echter geen tabel maar de URL's' met hun Naam worden genoteerd in een Array astrPaginas(3). In de onOpen gebeurtenis van het formulier worden de elementen aan de listBox toegevoegd ziehier de code:
De webpagina's worden weergegeven aan de hand van de klik gebeurtenis van de listBox, ziehier de code:
hallo