AW: Ereignisprozedur bei Monatswechsel
04.02.2005 22:16:38
Korl
Hallo Sepp,
entschuldige bitte wenn ich mich etwas unklar ausgedrückt hatte.
Jetzt wird es aber mit meinen Ereignissprozeduren in der Tabelle "Stamm" etwas eng!
Dort habe ich nun zwei "
Private Sub Worksheet_Change(ByVal Target As Range)" stehen.
Für die Datumeingabe ohne Punkt:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Bereich As Range
Dim Datum As String
Dim Tar2 As String
Dim j As String, m As String, t As String
Set Bereich = Range("B7", "B132")
If Not Intersect(Target, Bereich) Is Nothing Then
Application.EnableEvents = False
On Error GoTo err
Tar2 = CStr(CLng(Target.Value))
If Len(Tar2) = 6 Or Len(Tar2) = 5 Then ' neu: Or Len(Tar2) = 5
' neu
If Len(Tar2) = 6 Then
t = Left(Tar2, 2)
Else
t = "0" & Left(Tar2, 1)
End If
' neu
If Len(Tar2) = 6 Then
m = Mid(Tar2, 3, 2)
Else
m = Mid(Tar2, 2, 2)
End If
j = Right(Tar2, 2)
If Val(j) > 30 Then
j = "19" & j
Else
j = "20" & j
End If
Datum = t & "." & m & "." & j
If IsDate(Datum) Then
' neu
Target = CDate(Datum)
Target.NumberFormat = "dd.mm.yyyy"
Else
Target = ""
Target.Activate
End If
Else ' neu
Target.ClearContents ' neu
End If
Application.EnableEvents = True
On Error GoTo 0
End If
Exit Sub
err:
Application.EnableEvents = True
End Sub
und jetzt Deine:
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$F$3" Then
On Error GoTo errorhandler
If Target <> oldVal Then
Application.EnableEvents = False
Range("B7:C140").ClearContents
Sheets("Liste").Range("A3:G160").Clear
oldVal = Target
End If
End If
errorhandler:
Application.EnableEvents = True
End Sub
Lassen sich diese beiden Ereignissprozeduren irgenwie zusammen schrauben?
Bei einfachen Subprozeduren kann ich mir manchmal etwas anpassen aber Ereignissprozeduren, oh man, oh man!
Gruß Korl