Option Compare Database
Option Explicit
Dim nFreeColor As Long
Private Sub Form_Load()
    nFreeColor = fcDomWert("ArtCol", "tbl_Art", "[ArtArt]=" & "'Frei'", ltDLookup)
End Sub

Private Sub ResetBelegung()
    Dim frm As Form, ctl As Control
    Set frm = Me
    For Each ctl In frm.Controls
        If ctl.ControlType = acLabel And Left(ctl.Name, 1) = "z" Then
            ctl.BackColor = nFreeColor
        End If
    Next
End Sub

Private Sub Belegung()
    Dim sDate As String
    Dim sSQL As String
    Dim vSet As Variant
    Dim rsBelegung As DAO.Recordset
    'SQL konformes Datum
    sDate = Sqldatum(Me.txt_Dat)
    sSQL = "SELECT tbl_Zimmer.ID_Zimmer, tbl_Zimmer.ZimmerNr, tbl_Belegung.ID_Kunde, tbl_Belegung.Datum_Von, tbl_Belegung.Datum_Bis, tbl_Art.ArtCol " & _
           "FROM tbl_Art INNER JOIN (tbl_Kunden INNER JOIN (tbl_Zimmer INNER JOIN tbl_Belegung ON tbl_Zimmer.ID_Zimmer = tbl_Belegung.ID_Zimmer) " & _
           "ON tbl_Kunden.KundenID = tbl_Belegung.ID_Kunde) ON tbl_Art.ArtID = tbl_Belegung.BelegungArt " & _
           "WHERE (((tbl_Belegung.Datum_Von) <=" & sDate & ") AND ((tbl_Belegung.Datum_Bis) >=" & sDate & "));"
    Set rsBelegung = CurrentDb.OpenRecordset(sSQL)
    'durchlaufen der Label und Einfärben
    Do While Not rsBelegung.EOF
        vSet = "z" & rsBelegung!ZimmerNr
        If Not IsNull(rsBelegung!ArtCol) Then
            Me(vSet).BackColor = rsBelegung!ArtCol
        Else
            Me(vSet).BackColor = nFreeColor
        End If
        rsBelegung.MoveNext
    Loop
    rsBelegung.Close
End Sub

Private Sub Form_Current()
    Call ResetBelegung
    Call Belegung
End Sub

• Einlesen von Dateien mit Angabe der Ordnertiefe in eine MS-Access Datenbank
• Ermitteln und Beenden von externen Programmen
• Arbeiten mit EXIF-Tags
• Arbeiten mit der Registry
• Übersicht der Fehlermeldungen von MS-Access