Private Sub cmdDelete_Click()
       If Grid1.Recordset.RecordCount = 1 Then
        MsgBox "Datensatz kann nicht gelöscht werden ! ", vbInformation
        Exit Sub
    Else
    Dim bCancel As Boolean
        If MsgBox("Sind Sie sicher das Sie diesen Kontakt löschen wollen ? " & _
          "Wenn Sie mit ' Ja ' bestätigen wird der Eintrag unwiderruflich" & _
          "gelöscht .", vbQuestion + vbYesNo, "Löschen") = vbNo Then
            ' Abbruch!
            bCancel = True
        Else
            dbÖffnen ("Adressen")
            DatensatzSuchenINT ("ID"), lblID.Caption
                Tabelle.Delete
            dbSchließen ("Adressen")
        End If
    End If
 
End Sub

Private Sub Grid1_CellDblClick(ByVal nRow As Long, ByVal nCol As Long)
    Dim sSQL As String
 
' Datenbank öffnen
    If dbOpen(App.Path & "\Adresse.mdb") Then
    ' Recordset-Objekt erstellen
    sSQL = "SELECT Adressen.ID, Adressen.Name, Adressen.Vorname," & _
      "Partner.Vorname, Adressen.EMail FROM Adressen INNER JOIN Partner ON" & _
      "Adressen.ID = Partner.ID ORDER BY Adressen.Name, Adressen.Vorname"
        oRS.CursorLocation = adUseClient
    oRS.Open sSQL, oConn, adOpenStatic, adLockOptimistic
 
    With Grid1
      ' autom. Neuzeichnen ausschalten
      .LockUpdate True
      .Clear True
 
      ' Recordset-Kopie erstellen
      .CreateClone = True
 
      ' Recordset zuweisen
      Set .Recordset = oRS
 
      .Columns(5).ColType = TYPE_EMAIL Or TYPE_IMAGE
 
     .Columns(3).Caption = "Vorname"
     .Columns(4).Caption = "Partner(in)"
     .Columns(5).Caption = "E-Mail"
 
      ' Spaltenbreiten festlegen
      .Columns(1).Width = 650
      .Columns(1).Visible = False
      .Columns(2).Width = 1500
      .Columns(3).Width = 1500
      .Columns(4).Width = 1200
      .Columns(5).Width = 3200
 
      .Icons.Add Image3.Picture
 
      ' zuletzt gespeicherte Spaltenbreiten wiederherstellen
      .ReadColumnWidth "MyApplication", "Grid1", "ColWidths"
 
      ' autom. Sortierung aktivieren
      .AutoSort = True
 
        .DoSort "Name"
 
      ' interaktives Hinzufügen, Ändern und Löschen ermöglichen
      .AllowEdit = False
      .AutoUpdate = True
      .AllowDelete = False
 
      ' interaktives Ändern der Spaltenbreiten zulassen
      .AllowColumnSizing = True
 
      ' autom. Neuzeichnen einschalten
      .LockUpdate False
      .Refresh
 
      ' 1. Zeile selektieren
      .Row = 1
 
        ' usprüngliches Recordset zerstören
      oRS.Close
      Set oRS = Nothing
 
 
    nRow = Grid1.Recordset.Fields(0)
    lblID.Caption = nRow
 
    End With
   End If
 
   ' Daten aus Tab Adressen einlesen für erste Reihe
     dbÖffnen ("Adressen")
     DatensatzSuchenINT ("ID"), lblID.Caption
 
        txtAdress(1).Text = Tabelle("Straße")
        txtAdress(2).Text = Tabelle("PLZ")
        txtAdress(3).Text = Tabelle("Ort")
        txtAdress(4).Text = Tabelle("Telefon")
        txtAdress(5).Text = Tabelle("Handy")
        txtAdress(6).Text = Tabelle("EMail")
        txtAdress(7).Text = Tabelle("Bild")
        txtAdress(8).Text = Tabelle("Geburtstag")
    dbSchließen ("Adressen")
 
    ' Daten aus Tab Partner einlesen für erste Reihe
    dbÖffnen ("Partner")
     DatensatzSuchenINT ("ID"), lblID.Caption
 
        txtAdress(9).Text = Tabelle("Geburtstag")
        txtAdress(10).Text = Tabelle("Bild")
        txtAdress(11).Text = Tabelle("Telefon")
        txtAdress(12).Text = Tabelle("Handy")
    dbSchließen ("Partner")
 
    Dim sFile As String
    Dim sFile1 As String
    sFile = txtAdress(7).Text
    sFile1 = txtAdress(10).Text
 
    ' prüfen ob File existiert und Bilder anzeigen
    If FileExists(txtAdress(7).Text) Then
        Image1.Picture = LoadPicture(sFile)
    Else
        Image1.Picture = LoadPicture(App.Path & "\leer.jpg")
    End If
 
    If FileExists(txtAdress(10).Text) Then
        Image2.Picture = LoadPicture(sFile1)
    Else
        Image2.Picture = LoadPicture(App.Path & "\leer.jpg")
    End If
End Sub