Dieses Demoformular zeigt Ihnen eine weitere Möglichkeit der Funktion "Bei Nicht in Liste". Wenn Sie [Strg] + [Entf] drücken, können Sie den ausgewählten Eintrag aus der Liste entfernen. Durch Drücken von [Strg] + [Return] können Sie den ausgewählten Eintrag sogar ändern. Erstellen Sie ein neues Formular und fügen Sie folgende Steuerelemente ein:
Option Compare Database Option Explicit Private Sub Bezeichnung_AfterUpdate() On Error GoTo Err_Bezeichnung_AfterUpdate Dim db As Database, DSGruppe1 As Recordset If ((IsNull(Me![Bezeichnung])) Or _ (Me![Bezeichnung] = "")) Then Exit Sub If Not IsNull(DLookup("[Eintrag]", "tbl_Einträge", _ "[Eintrag] = '" & Me![Bezeichnung] & "'")) Then Exit Sub End If If vbYes = MsgBox("Möchten Sie " & Chr(34) & _ Me![Bezeichnung] & Chr(34) & " zur Liste hinzufügen?", _ vbYesNo + vbQuestion, "Microsys Kramer - Demo") Then Set db = CurrentDb Set DSGruppe1 = db.OpenRecordset("tbl_Einträge") DSGruppe1.AddNew DSGruppe1!Eintrag = Me![Bezeichnung] DSGruppe1.Update DSGruppe1.Close Me![Bezeichnung].Requery End If Exit_Bezeichnung_AfterUpdate: Exit Sub Err_Bezeichnung_AfterUpdate: MsgBox Err.Description Resume Exit_Bezeichnung_AfterUpdate End Sub Private Sub Bezeichnung_KeyDown(KeyCode As Integer, _ Shift As Integer) ' On Error GoTo Err_Bezeichnung_KeyDown Dim db As Database, DSGruppe1 As Recordset Dim Kriterien As String Dim Mldg, Titel, Voreinstellung Dim H_Bezeichnung As String Mldg = "Geben Sie eine Bezeichnung ein!" Titel = "Microsys Kramer - Demo" If ((KeyCode = 46) And (Shift = 2)) Then If ((IsNull(Me![Bezeichnung])) Or _ (Me![Bezeichnung] = "")) Then Exit Sub If IsNull(DLookup("[Eintrag]", "tbl_Einträge", _ "[Eintrag] = '" & Me![Bezeichnung] & "'")) Then Exit Sub End If If vbYes = MsgBox("Möchten Sie " & Chr(34) & _ Me![Bezeichnung] & Chr(34) & _ " aus Liste löschen?", vbYesNo + vbQuestion, _ "Microsys Kramer - Demo") Then DoCmd.Hourglass True Set db = CurrentDb Set DSGruppe1 = db.OpenRecordset("tbl_Einträge", _ DB_OPEN_DYNASET) Kriterien = "[Eintrag] = '" & Me![Bezeichnung] & "'" DSGruppe1.FindFirst Kriterien If Not DSGruppe1.NoMatch Then DSGruppe1.Delete End If Me![Bezeichnung].Requery DSGruppe1.Close Me![Bezeichnung] = Null DoCmd.Hourglass False End If End If If ((KeyCode = 13) And (Shift = 2)) Then If ((IsNull(Me![Bezeichnung])) Or _ (Me![Bezeichnung] = "")) Then Exit Sub H_Bezeichnung = InputBox(Mldg, Titel, Bezeichnung) If (H_Bezeichnung = "") Or _ (IsNull(H_Bezeichnung)) Then Exit Sub Set db = CurrentDb Set DSGruppe1 = db.OpenRecordset("tbl_Einträge", _ DB_OPEN_DYNASET) DSGruppe1.FindFirst "Eintrag = '" & _ Me![Bezeichnung] & "'" If Not DSGruppe1.NoMatch Then DSGruppe1.Edit DSGruppe1!Eintrag = H_Bezeichnung DSGruppe1.Update End If DSGruppe1.Close Me![Bezeichnung] = H_Bezeichnung Me![Bezeichnung].Requery End If Exit_Bezeichnung_KeyDown: Exit Sub Err_Bezeichnung_KeyDown: MsgBox Err.Description Resume Exit_Bezeichnung_KeyDown End Sub Private Sub Bezeichnung_NotInList(NewData As String, _ Response As Integer) On Error GoTo Err_Bezeichnung_NotInList Dim db As Database, DSGruppe1 As Recordset If vbYes = MsgBox("Möchten Sie " & Chr(34) & _ NewData & Chr(34) & " zur Liste hinzufügen?", _ vbYesNo + vbQuestion, "Microsys Kramer - Demo") Then Set db = CurrentDb Set DSGruppe1 = db.OpenRecordset("tbl_Einträge") DSGruppe1.AddNew DSGruppe1!Eintrag = NewData DSGruppe1.Update DSGruppe1.Close Response = acDataErrAdded Else Response = acDataErrDisplay End If Exit_Bezeichnung_NotInList: Exit Sub Err_Bezeichnung_NotInList: MsgBox Err.Description Resume Exit_Bezeichnung_NotInList End Sub Private Sub OK_Click() On Error GoTo Err_OK_Click DoCmd.Close Exit_OK_Click: Exit Sub Err_OK_Click: MsgBox Err.Description Resume Exit_OK_Click End Sub Dieser Tipp wurde bereits 17.101 mal aufgerufen. Voriger Tipp | Zufälliger Tipp | Nächster Tipp
Anzeige
Diesen und auch alle anderen Tipps & Tricks finden Sie auch auf unserer aktuellen vb@rchiv Vol.6 (einschl. Beispielprojekt!) Ein absolutes Muss - Geballtes Wissen aus mehr als 8 Jahren vb@rchiv! - nahezu alle Tipps & Tricks und Workshops mit Beispielprojekten - Symbol-Galerie mit mehr als 3.200 Icons im modernen Look Weitere Infos - 4 Entwickler-Vollversionen (u.a. sevFTP für .NET), Online-Update-Funktion u.v.m. |
Neu! sevEingabe 3.0 Einfach stark! Ein einziges Eingabe-Control für alle benötigten Eingabetypen und -formate, inkl. Kalender-, Taschenrechner und Floskelfunktion, mehrspaltige ComboBox mit DB-Anbindung, ImageComboBox u.v.m. Tipp des Monats April 2024 Skyfloy Chart von Microsoft und dazu noch gratis Tutorial für Microsoft Chart Controls für Microsoft .NET Framework 3.5 TOP Entwickler-Paket TOP-Preis!! Mit der Developer CD erhalten Sie insgesamt 24 Entwickler- komponenten und Windows-DLLs. Die Einzelkomponenten haben einen Gesamtwert von 1605.50 EUR... |
||||||||||||||||
Microsoft, Windows und Visual Basic sind entweder eingetragene Marken oder Marken der Microsoft Corporation in den USA und/oder anderen Ländern. Weitere auf dieser Homepage aufgeführten Produkt- und Firmennamen können geschützte Marken ihrer jeweiligen Inhaber sein. |