Private Sub txtDCV_AfterUpdate()
txtDCV = Format(txtDCV, "dd.mm.yyyy")
End Sub
Private Sub txtDCV_Exit(ByVal Cancel As MSForms.ReturnBoolean)
If Not IsDate(txtDCV) Then
MsgBox prompt:="Geben Sie ein gültiges Datum ein."
txtDCV = ""
Cancel = True
End If
End Sub
Private Sub txtDCV_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
Call SF_DatePick.DatePickinCtl(Me.txtDCV)
End Sub
Private Sub btnCalendar_Click()
Call SF_DatePick.DatePickinCtl(Me.txtDCV)
End Sub
Private Sub cmdSave_Click()
'Übertragen der Daten in Tabelle
Dim lngLastRow As Long
Dim bytLastCol As Byte
Dim ws As Worksheet
Dim vntCtrl As Variant
Dim x As Byte, i As Integer, col As Byte
Set ws = Worksheets("ListOfPatients")
lngLastRow = ws.Cells(Rows.Count, 1).End(xlUp).Row
bytLastCol = ws.Cells(8, Columns.Count).End(xlToLeft).Column
'vntCtrl = Array("cbPatID", "txtPatName", "optAG1", "txtSV", "txtIDV", "txtTV1", "txtTV2", " _
txtTV3", "txtTV4", "txtTV5", "txtDCV", "txtSCV14", _
' "txtSCV28", "txtSCV42", "txtSCV56", "txtFUS1", "txtFUS3", "txtFUS7", "txtFUS10" _
)
If lngLastRow = 8 And Cells(8, 1) = "" Then x = 0 Else x = 1
With ws
.Cells(lngLastRow + x, 1) = cbPatID
.Cells(lngLastRow + x, 2) = txtPatName
.Cells(lngLastRow + x, 3) = "Agegroup?"
.Cells(lngLastRow + x, 4) = txtSV
.Cells(lngLastRow + x, 5) = txtIDV
.Cells(lngLastRow + x, 6) = txtTV1
.Cells(lngLastRow + x, 7) = txtTV2
.Cells(lngLastRow + x, 8) = txtTV3
.Cells(lngLastRow + x, 9) = txtTV4
.Cells(lngLastRow + x, 10) = txtTV5
.Cells(lngLastRow + x, 11) = txtDCV
.Cells(lngLastRow + x, 12) = txtSCV14
.Cells(lngLastRow + x, 13) = txtSCV28
.Cells(lngLastRow + x, 14) = txtSCV42
.Cells(lngLastRow + x, 15) = txtSCV56
.Cells(lngLastRow + x, 16) = txtFUS1
.Cells(lngLastRow + x, 17) = txtFUS3
.Cells(lngLastRow + x, 18) = txtFUS7
.Cells(lngLastRow + x, 19) = txtFUS10
End With
End Sub
Für den Spaghetti-Code habe ich 5 Minuten gebraucht. Mein Versuch das ganze elegant über ein Array zu lösen, um es auf ein paar wenige Zeilen einzudampfen, hat mich 2 Stunden gekostet und kein Ergebnis gebracht.
Die Datei https://www.herber.de/bbs/user/100851.xlsm wurde aus Datenschutzgründen gelöscht
Private Sub TextBox8_AfterUpdate()
TextBox9.Value = CDate(TextBox8.Value) + 14 - 2
TextBox10.Value = CDate(TextBox8.Value) + 28 - 2
TextBox11.Value = CDate(TextBox8.Value) + 42 - 2
TextBox12.Value = CDate(TextBox8.Value) + 56 - 2
End Sub
Leider ist es wohl das falsche Ereignis - zumindest wenn ich das Datum per Datepicker eingebe, dann passiert nichts und ich muss nochmal in die Zelle, eine Zahl ändern und dann werden die Werte wie gewünscht in die anderen Textboxen eingetragen wenn ich EWnter betätige. Kannst du mir sagen, woran das liegt?
Private Sub txtDCV_AfterUpdate()
txtDCV = Format(txtDCV, "dd.mm.yyyy")
End Sub
Private Sub txtDCV_Exit(ByVal Cancel As MSForms.ReturnBoolean)
If Not IsDate(txtDCV) Then
MsgBox prompt:="Geben Sie ein gültiges Datum ein."
txtDCV = ""
Cancel = True
End If
End Sub
Private Sub txtDCV_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
Call SF_DatePick.DatePickinCtl(Me.txtDCV)
End Sub
Private Sub btnCalendar_Click()
Call SF_DatePick.DatePickinCtl(Me.txtDCV)
End Sub
Private Sub cmdSave_Click()
'Übertragen der Daten in Tabelle
Dim lngLastRow As Long
Dim bytLastCol As Byte
Dim ws As Worksheet
Dim vntCtrl As Variant
Dim x As Byte, i As Integer, col As Byte
Set ws = Worksheets("ListOfPatients")
lngLastRow = ws.Cells(Rows.Count, 1).End(xlUp).Row
bytLastCol = ws.Cells(8, Columns.Count).End(xlToLeft).Column
'vntCtrl = Array("cbPatID", "txtPatName", "optAG1", "txtSV", "txtIDV", "txtTV1", "txtTV2", " _
txtTV3", "txtTV4", "txtTV5", "txtDCV", "txtSCV14", _
' "txtSCV28", "txtSCV42", "txtSCV56", "txtFUS1", "txtFUS3", "txtFUS7", "txtFUS10" _
)
If lngLastRow = 8 And Cells(8, 1) = "" Then x = 0 Else x = 1
With ws
.Cells(lngLastRow + x, 1) = cbPatID
.Cells(lngLastRow + x, 2) = txtPatName
.Cells(lngLastRow + x, 3) = "Agegroup?"
.Cells(lngLastRow + x, 4) = txtSV
.Cells(lngLastRow + x, 5) = txtIDV
.Cells(lngLastRow + x, 6) = txtTV1
.Cells(lngLastRow + x, 7) = txtTV2
.Cells(lngLastRow + x, 8) = txtTV3
.Cells(lngLastRow + x, 9) = txtTV4
.Cells(lngLastRow + x, 10) = txtTV5
.Cells(lngLastRow + x, 11) = txtDCV
.Cells(lngLastRow + x, 12) = txtSCV14
.Cells(lngLastRow + x, 13) = txtSCV28
.Cells(lngLastRow + x, 14) = txtSCV42
.Cells(lngLastRow + x, 15) = txtSCV56
.Cells(lngLastRow + x, 16) = txtFUS1
.Cells(lngLastRow + x, 17) = txtFUS3
.Cells(lngLastRow + x, 18) = txtFUS7
.Cells(lngLastRow + x, 19) = txtFUS10
End With
End Sub
Für den Spaghetti-Code habe ich 5 Minuten gebraucht. Mein Versuch das ganze elegant über ein Array zu lösen, um es auf ein paar wenige Zeilen einzudampfen, hat mich 2 Stunden gekostet und kein Ergebnis gebracht.
Die Datei https://www.herber.de/bbs/user/100851.xlsm wurde aus Datenschutzgründen gelöscht
Private Sub TextBox8_AfterUpdate()
TextBox9.Value = CDate(TextBox8.Value) + 14 - 2
TextBox10.Value = CDate(TextBox8.Value) + 28 - 2
TextBox11.Value = CDate(TextBox8.Value) + 42 - 2
TextBox12.Value = CDate(TextBox8.Value) + 56 - 2
End Sub
Leider ist es wohl das falsche Ereignis - zumindest wenn ich das Datum per Datepicker eingebe, dann passiert nichts und ich muss nochmal in die Zelle, eine Zahl ändern und dann werden die Werte wie gewünscht in die anderen Textboxen eingetragen wenn ich EWnter betätige. Kannst du mir sagen, woran das liegt?