Excel und VBA: Formeln, Programmierung, Lösungen

ClassModule: frmDate

Private Sub cmdWeiter_Click()
   Unload Me
End Sub

Private Sub txtDatum_Change()
   Dim dat As Date
   Dim iRow As Integer
   Dim sTxt As String
   sTxt = txtDatum.Text
   If sTxt = "" Then Exit Sub
   If Right(sTxt, 1) Like "[0-9]" = False Then
      Beep
      sTxt = Left(sTxt, Len(sTxt) - 1)
      txtDatum.Text = sTxt
   End If
   If Len(sTxt) = 4 Then
      On Error Resume Next
      dat = DateSerial(Year(Date), Right(sTxt, 2), Left(sTxt, 2))
      If Err > 0 Then
         MsgBox "Falsches Datum!"
         Err = 0
         txtDatum.Text = ""
         Exit Sub
      End If
      iRow = WorksheetFunction.CountA(Columns(1)) + 1
      Cells(iRow, 1) = dat
      txtDatum.Text = ""
   End If
End Sub

StandardModule: basMain

Sub CallForm()
   frmDate.Show
End Sub

    

Beiträge aus dem Excel-Forum zu den Themen Dialog und TextBox