Anwendungs. o objektorientierter Fehlerl

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Private Sub But_Aendern_Click() Dim findeZelle As Range Dim Antwort As String Dim lngL As Long Antwort = MsgBox("Sollen die Patientendaten geändert werden?", vbYesNoCancel, "Datensatzä _ nderung speichern?") If Antwort = vbYes Then 'Blattschutz aufheben ActiveSheet.Unprotect ActiveSheet.Protect DrawingObjects:=False, Contents:=True, Scenarios:= _ False, AllowFiltering:=True

Hi, einmal gibt es ein problem mit dem Blattschutz, der muss "oben" im Code raus, außerdem läuft der Code immer in das Worksheet_Change-Ereignis des Tabellenblattes. Daher würde ich die Ereignisse mit Application-EnableEvents ausschalten:

Private Sub But_Aendern_Click()
Dim findeZelle As Range
Dim Antwort As String
Dim lngL As Long
Application.EnableEvents = False
Antwort = MsgBox("Sollen die Patientendaten geändert werden?", vbYesNoCancel, "Datensatzä _
nderung speichern?")
If Antwort = vbYes Then
'Blattschutz aufheben
ActiveSheet.Unprotect
'  ActiveSheet.Protect DrawingObjects:=False, Contents:=True, Scenarios:= _
False, AllowFiltering:=True
lngL = Sheets("Priorität").Cells(Rows.Count, 1).End(xlUp).Row
Set findeZelle = Sheets("Priorität").Range("A9:A" & lngL).Find(LfdNr_TB, , LookIn:=xlValues, _
lookat:=xlWhole)
If Not findeZelle Is Nothing Then
With Sheets("Priorität")
.Cells(findeZelle.Row, 2) = Me.Vorname_TB
.Cells(findeZelle.Row, 3) = Me.Name_TB
.Cells(findeZelle.Row, 4) = CLng(Me.Telefon_TB)
.Cells(findeZelle.Row, 6) = CDate(Me.GebDatum_TB)
.Cells(findeZelle.Row, 7) = Me.Bemerkungen_TB
.Cells(findeZelle.Row, 8) = Me.Diagnose_CB
.Cells(findeZelle.Row, 9) = CDate(Me.Diagnosedatum_TB)
.Cells(findeZelle.Row, 10) = Me.Tumor_CB
.Cells(findeZelle.Row, 11) = Me.Lymphknoten_CB
.Cells(findeZelle.Row, 12) = Me.Metastasen_CB
.Cells(findeZelle.Row, 13) = Me.Tumorstadium_CB
.Cells(findeZelle.Row, 14) = Me.Tumorwachstum_CB
If OPAbgeschlossen_TB  "" Then .Cells(findeZelle.Row, 19) = CDate(Me. _
OPAbgeschlossen_TB)
End With
'Blatt schützen
ActiveSheet.Protect
ActiveSheet.Protect DrawingObjects:=False, Contents:=True, Scenarios:= _
False, AllowFiltering:=True
ActiveWorkbook.Save
Else
MsgBox "nicht gefunden!", vbExclamation
Exit Sub
End If
ElseIf Antwort = vbNo Then
MsgBox "Datensatz nicht geändert"
Unload Eingabe_Patientendaten
Exit Sub
Else
MsgBox "Abgebrochen"
Unload Eingabe_Patientendaten
Exit Sub
End If
Application.EnableEvents = True
Unload Eingabe_Patientendaten
End Sub

Gruß Regina

So:

Private Sub But_Aendern_Click()

    Dim findeZelle As Range
    Dim Antwort As VbMsgBoxResult

    Antwort = MsgBox("Sollen die Patientendaten geändert werden?", vbQuestion Or vbYesNo, "Datensatzänderung speichern?")

    If Antwort = vbYes Then

        With Worksheets("Priorität")

            Set findeZelle = .Columns(1).Find(LfdNr_TB.Text, LookIn:=xlValues, LookAt:=xlWhole)

            If Not findeZelle Is Nothing Then

                Application.EnableEvents = False

                'Blattschutz aufheben
                .Unprotect

                .Cells(findeZelle.Row, 2).Value = Vorname_TB.Text
                .Cells(findeZelle.Row, 3).Value = Name_TB.Text
                .Cells(findeZelle.Row, 4).Value = Clng(Telefon_TB.Text)
                .Cells(findeZelle.Row, 6).Value = CDate(GebDatum_TB.Text)
                .Cells(findeZelle.Row, 7).Value = Bemerkungen_TB.Text
                .Cells(findeZelle.Row, 8).Value = Diagnose_CB.Text
                .Cells(findeZelle.Row, 9).Value = CDate(Diagnosedatum_TB.Text)
                .Cells(findeZelle.Row, 10).Value = Tumor_CB.Text
                .Cells(findeZelle.Row, 11).Value = Lymphknoten_CB.Text
                .Cells(findeZelle.Row, 12).Value = Metastasen_CB.Text
                .Cells(findeZelle.Row, 13).Value = Tumorstadium_CB.Text
                .Cells(findeZelle.Row, 14).Value = Tumorwachstum_CB.Text
                If OPAbgeschlossen_TB.textlength > 0 Then .Cells(findeZelle.Row, 19).Value = CDate(OPAbgeschlossen_TB.Text)

                'Blatt schützen
                .Protect DrawingObjects:=False, Contents:=True, Scenarios:=False, AllowFiltering:=True

                ThisWorkbook.Save

                Application.EnableEvents = True

            Else
                MsgBox "Nicht gefunden!", vbExclamation, "Hinweis"
            End If
        End With

    ElseIf Antwort = vbNo Then

        MsgBox "Datensatz nicht geändert", vbInformation, "Information"

    End If

    Unload Me

End Sub

Gruß
Nepumuk

Beliebteste Forumthreads (12 Monate)

Anwendungs. o objektorientierter Fehlerl

8 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

8
Beiträge zum Forumthread

Beiträge zu diesem Forumthread