Option Explicit
 
Const db_file As String = "db1.mdb"
Const txtNoKey As String = "Ich hasse Tiere!!!"
 
Dim DB As DAO.Database
Dim TierRS As DAO.Recordset
 
Private Sub Form_Load()
    On Error GoTo ErrorHandler
    'Controls vorbereiten
    Check1.Caption = "Mit ComboBox..."
    Command1.Caption = "AddNew()"
    Command2.Caption = "Show Record..."
    'Datenbank öffnen
    Set DB = DBEngine.OpenDatabase(db_file)
    'Form-globalen Recordset auf die MasterTabelle öffnen
    Set TierRS = DB.OpenRecordset("Tier", dbOpenSnapshot)
    'Grid einrichten und Recordset auf DetailTabelle zuweisen
    With sevGrid1
        .DataMode = Mode_Recordset
'        .SaveNullValues = False
        .AllowEdit = True
        Set .Recordset = DB.OpenRecordset("SELECT * FROM Mensch;")
        .Columns("LieblingsHaustierID").SaveEmptyValueAsNullValue = True
        .Columns("LieblingsHaustierID").Width = 1500
        .Refresh
    End With
    'ComboBox aktivieren
    Check1.Value = 1
    Exit Sub
ErrorHandler:
    MsgBox Err.Number & ": " & Err.Description, vbCritical, "Fehler", _
      Err.HelpFile, Err.HelpContext
End Sub
 
Private Sub Form_Unload(Cancel As Integer)
    On Error Resume Next
    TierRS.Close
    DB.Close
End Sub
 
Private Sub Check1_Click()
    'Umschalten zwischen ComboBox und keiner ComboBox
    If Check1.Value = 1 Then
        'Aktiviere ComboBox
        sevGrid1.Columns("LieblingsHaustierID").ColType = TYPE_COMBOLIST
        sevGrid1.Refresh    'nötig um die RowLoaded-Ereignisse auszulösen
    Else
        'Deaktiviere ComboBox
        sevGrid1.Columns("LieblingsHaustierID").ColType = TYPE_TEXT
        sevGrid1.Refresh
    End If
End Sub
 
Private Sub Command1_Click()
    'Neuen Datensatz einfügen
    sevGrid1.AddNew
End Sub
 
Private Sub Command2_Click()
    Dim fld As DAO.Field
    Dim msgtxt As String
 
    'Inhalt des Datensatzes zur Kontrolle ausgeben
    For Each fld In sevGrid1.Recordset.Fields
        msgtxt = msgtxt & fld.Name & ": "
        If Not IsNull(fld.Value) Then
            If fld.Type = dbText Then
                msgtxt = msgtxt & "'" & fld.Value & "'"
            Else
                msgtxt = msgtxt & fld.Value
            End If
        Else
            msgtxt = msgtxt & "NULL"
        End If
        msgtxt = msgtxt & vbLf
    Next fld
    MsgBox msgtxt
End Sub
 
Private Sub sevGrid1_ErrorAddNew(ByVal nError As Long, ByVal sDescription As _
  String)
    MsgBox nError & ": " & sDescription
 
End Sub
 
Private Sub sevGrid1_ErrorUpdate(ByVal nRow As Long, ByVal nCol As Long, ByVal _
  sText As String, ByVal nError As Long, ByVal sDescription As String)
    MsgBox nError & ": " & sDescription
End Sub
 
Private Sub sevGrid1_FillComboBox(ByVal nRow As Long, ByVal nCol As Long, _
  oComboBox As sevDataGrid2.EditComboBox)
    'Werte aus der Tier-Tabelle füllen
    With oComboBox
        Set .Recordset = DB.OpenRecordset("SELECT '' AS TierID, '" & txtNoKey & _
          "' AS TierName FROM Tier UNION SELECT TierID, TierName FROM Tier;")
        .ColVisible("TierID") = False
        .ColVisible("TierName") = True
        .BoundColumn = 1
        .DisplayColumn = 2
    End With
End Sub
 
Private Sub sevGrid1_RowLoaded(ByVal nRow As Long, Item As _
  sevDataGrid2.ListItem)
    If Check1.Value = 1 Then
        'Numerischen Schlüssel durch den Text ersetzen
        If Item.CellText("LieblingsHaustierID") = "" Then
            'Kein Fremdschlüssel zugewiesen -> Leer anzeigen
            Item.CellText("LieblingsHaustierID") = txtNoKey
        Else
            TierRS.FindFirst "TierID = " & Item.CellText("LieblingsHaustierID")
            If TierRS.EOF Then
                Item.CellText("LieblingsHaustierID") = ""
            Else
                Item.CellText("LieblingsHaustierID") = TierRS.Fields( _
                  "TierName").Value
            End If
        End If
    End If
End Sub