title image


Smiley Re: Datensatz nach Aktualisierung einstellen
Hallo Reinhard,



ich habe hier den gesamten Code des Formulars. Mir ist beim Auslesen der Variablen gerade aufgefallen, dass Access in der Variable Bookmark ein Fragezeichen hat, also keine Nummer oder sonstwas.





Gruss Wolfgang













Option Compare Database

Option Explicit





Private Sub cboMitarbeiter_KeyDown(KeyCode As Integer, Shift As Integer)

On Error GoTo ErrorHandler:

Dim strMsg01 As String

Dim byteMsg01 As Byte



If KeyCode = vbKeyEscape Then

strMsg01 = "Die Aktion wurde mit ESC abgebrochen"

byteMsg01 = MsgBox(strMsg01, vbOKOnly + vbInformation, " ")

If byteMsg01 = vbOK Then

Me.Undo

DoCmd.GoToRecord , , acFirst

End If

End If



ErrorHandler:

If Err.Number 0 Then

If Err.Number = 2105 Then 'Sie können nicht zu dem angegebenen Datensatz springen

Exit Sub

Else

MsgBox Err.Number & " " & Err.Description

End If

End If

End Sub





Private Sub cboAnrede_AfterUpdate()

On Error GoTo ErrorHandler



Me.strTitel.SetFocus



ErrorHandler:

If Err.Number 0 Then

MsgBox Err.Number & " " & Err.Description

End If

End Sub



Private Sub cboMitarbeiterAuswählen_AfterUpdate()

On Error GoTo ErrorHandler

Dim byteRecordNr As Byte

Dim strMsg01 As String

Dim byteMsg01 As Byte



byteRecordNr = Me.cboMitarbeiterAuswählen.ListIndex + 1

DoCmd.GoToRecord , , acGoTo, byteRecordNr



Me.strNachname.SetFocus

Me.cboMitarbeiterAuswählen.Visible = False



ErrorHandler:

If Err.Number 0 Then

If Err.Number = 3021 Then 'Kein aktueller Datensatz

strMsg01 = "Es sind keine Datensätze vorhanden!"

byteMsg01 = MsgBox(strMsg01, vbOKOnly + vbExclamation, " ")

If byteMsg01 = vbOK Then

Exit Sub

End If

Else

MsgBox Err.Number & Err.Description

End If

End If

End Sub



Private Sub cboMitarbeiterAuswählen_KeyDown(KeyCode As Integer, Shift As Integer)

On Error GoTo ErrorHandler

Dim strMsg01 As String

Dim byteMsg01 As Byte



If KeyCode = vbKeyEscape Then

Me.cmdMitarbeiterAuswählen.SetFocus

Me.cboMitarbeiterAuswählen.Visible = False

End If



ErrorHandler:

If Err.Number 0 Then

MsgBox Err.Number & " " & Err.Description

End If

End Sub



Private Sub cboMitarbeiterLöschen_Click()

On Error GoTo ErrorHandler

Dim strMsg01 As String

Dim byteMsg01 As Byte



DoCmd.SetWarnings False



strMsg01 = "Wollen Sie diesen Mitarbeiter wirklich löschen ?" & Chr(13) _

& Chr(13) & Me.strNachname & " " & Me.strVorname

byteMsg01 = MsgBox(strMsg01, vbYesNo + vbQuestion + vbDefaultButton2, " ")

If byteMsg01 = vbYes Then

DoCmd.RunCommand acCmdDeleteRecord

Me.cboMitarbeiterAuswählen.Requery

DoCmd.GoToRecord , , acFirst

End If



DoCmd.SetWarnings True

ErrorHandler:

If Err.Number 0 Then

If Err.Number = 2046 Then 'Der Befehl steht momentan nicht zur Verfügung

DoCmd.GoToRecord , , acFirst

Else

MsgBox Err.Number & " " & Err.Description

End If

End If



End Sub











Private Sub cmdMitarbeiterAnlegen_Click()

On Error GoTo ErrorHandler

Dim strMitarbeiterNrAlt As String

Dim strMitarbeiterNrNeu As String

Dim strMitarbeiterNrKompl As String

Dim strZählerNeu As String

Dim db As Database, rsMax As Recordset

Dim MaxWert As String

Dim strMsg01 As String

Dim byteMsg01 As Byte



Set db = CurrentDb



Set rsMax = db.OpenRecordset("SELECT max(tblKundenMitarbeiter.strMitarbeiterNrCnt) AS MaxWert" _

& " FROM tblKundenMitarbeiter;", dbOpenSnapshot)



strMitarbeiterNrAlt = rsMax(0)

strZählerNeu = Format$(CStr(Mid$(strMitarbeiterNrAlt, 5, 4)) + 1, "0000")



If CStr(Left$(strMitarbeiterNrAlt, 4)) Year(Date) Then

DoCmd.GoToRecord , , acNewRec

strMitarbeiterNrNeu = CStr(Year(Date) & "0001" & "11")

Me.strMitarbeiterNrCnt = strMitarbeiterNrNeu

Me.cboAnrede.SetFocus

Me.cboAnrede.Dropdown

Else

DoCmd.GoToRecord , , acNewRec

strMitarbeiterNrNeu = CStr(Year(Date) & strZählerNeu & "11")

Me.strMitarbeiterNrCnt = strMitarbeiterNrNeu

Me.cboAnrede.SetFocus

Me.cboAnrede.Dropdown



End If



ErrorHandler:

If Err.Number 0 Then

If Err.Number = 94 Then

DoCmd.GoToRecord , , acNewRec

strMitarbeiterNrNeu = CStr(Year(Date) & "0001" & "11")

Me.strMitarbeiterNrCnt = strMitarbeiterNrNeu

Me.cboAnrede.SetFocus

Me.cboAnrede.Dropdown



Else

MsgBox Err.Number & " " & Err.Description

End If

End If

End Sub



Private Sub cmdMitarbeiterAuswählen_Click()

On Error GoTo ErrorHandler



Me.Requery

Me.cboMitarbeiterAuswählen.Requery

Me.cboMitarbeiterAuswählen.Visible = True

Me.cboMitarbeiterAuswählen.SetFocus

Me.cboMitarbeiterAuswählen.Dropdown



ErrorHandler:

If Err.Number 0 Then

MsgBox Err.Number & " " & Err.Description

End If

End Sub



Private Sub cmdMitarbeiterAuswählen_Enter()

Call DatensatzEinstellen

End Sub



Private Sub Form_AfterUpdate()

On Error GoTo ErrorHandler

Dim db As Database

Dim rs As Recordset

Dim strLesezeichen As String

Dim strKriterium As String



Set db = CurrentDb

Set rs = db.OpenRecordset("tblKundenMitarbeiter", dbOpenDynaset)



strKriterium = "'" & Me.strMitarbeiterNrCnt & "'"

rs.FindFirst "[strMitarbeiterNrCnt] = " & strKriterium







If rs.NoMatch = False Then

strLesezeichen = rs.Bookmark

End If



rs.Bookmark = strLesezeichen



ErrorHandler:

If Err.Number 0 Then

MsgBox Err.Number & " " & Err.Description

End If

End Sub



Private Sub Form_BeforeUpdate(Cancel As Integer)

On Error GoTo ErrorHandler

Dim strMsg01 As String

Dim byteMsg01 As Byte



If Me.Dirty Then

strMsg01 = "Datensatz speichern?"

byteMsg01 = MsgBox(strMsg01, vbYesNo + vbQuestion, " ")

If byteMsg01 = vbNo Then

Me.Undo

End If

End If



ErrorHandler:

If Err.Number 0 Then

MsgBox Err.Number & " " & Err.Description

End If

End Sub



Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)

On Error GoTo ErrorHandler

Dim strMsg01 As String

Dim byteMsg01 As Byte



If KeyCode = vbKeyEscape And Me.Dirty = True Then

strMsg01 = "Soll die Aktion abgebrochen werden?"

byteMsg01 = MsgBox(strMsg01, vbYesNo + vbDefaultButton2 + vbExclamation, " ")

If byteMsg01 = vbYes Then

Me.Undo

DoCmd.GoToRecord , , acFirst

Else

KeyCode = 0

End If

End If



ErrorHandler:

If Err.Number 0 Then

If Err.Number = 2105 Then 'Sie können nicht zu dem angegebenen Datensatz springen

Exit Sub

Else

MsgBox Err.Number & " " & Err.Description

End If

End If

End Sub



Private Sub memMemo_Exit(Cancel As Integer)

On Error GoTo ErrorHandler



If Me.Dirty = True Then

Me.Requery

End If



ErrorHandler:

If Err.Number 0 Then

MsgBox Err.Number & " " & Err.Description

End If

End Sub



End Function

geschrieben von

Login

E-Mail:
  

Passwort:
  

Beitrag anfügen

Symbol:
 
 
 
 
 
 
 
 
 
 
 
 
 

Überschrift: