Fehler im Code ich komme nicht weiter

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Moin!
Also arbeite an Stelle von ActiveCell mit Target. DAmit hast du gleich die geänderte Zelle. Am Anfang noch die Spalte prüfen, damit du auch die hast, mit einem Datum. Das würde dann so aussehen.

Private Sub Worksheet_Change(ByVal Target As Range)
Dim Current_Date As Date
Dim Date_String As String
If Target.Column  33 And Target.Column  34 Then Exit Sub
Date_String = Target.Value
Current_Date = CDate(Date_String)
Target.Value = Current_Date
If Target.Address = "$AG$1" Then
With Worksheets("AQW´s").Shapes("Oval 30").Fill.ForeColor
Select Case Target
Case Is >= (Current_Date)
.RGB = RGB(0, 250, 0) 'grün
Case Is = (Current_Date)
.RGB = RGB(0, 250, 0) 'grün
Case Is = (Current_Date)
.RGB = RGB(0, 250, 0) 'grün
Case Is = (Current_Date)
.RGB = RGB(0, 250, 0) 'grün
Case Is = (Current_Date)
.RGB = RGB(0, 250, 0) 'grün
Case Is = (Current_Date)
.RGB = RGB(0, 250, 0) 'grün
Case Is = (Current_Date)
.RGB = RGB(0, 250, 0) 'grün
Case Is = (Current_Date)
.RGB = RGB(0, 250, 0) 'grün
Case Is = (Current_Date)
.RGB = RGB(0, 250, 0) 'grün
Case Is = (Current_Date)
.RGB = RGB(0, 250, 0) 'grün
Case Is = (Current_Date)
.RGB = RGB(0, 250, 0) 'grün
Case Is = (Current_Date)
.RGB = RGB(0, 250, 0) 'grün
Case Is = (Current_Date)
.RGB = RGB(0, 250, 0) 'grün
Case Is = (Current_Date)
.RGB = RGB(0, 250, 0) 'grün
Case Is = (Current_Date)
.RGB = RGB(0, 250, 0) 'grün
Case Is = (Current_Date)
.RGB = RGB(0, 250, 0) 'grün
Case Is = (Current_Date)
.RGB = RGB(0, 250, 0) 'grün
Case Is = (Current_Date)
.RGB = RGB(0, 250, 0) 'grün
Case Is = (Current_Date)
.RGB = RGB(0, 250, 0) 'grün
Case Is = (Current_Date)
.RGB = RGB(0, 250, 0) 'grün
Case Is = (Current_Date)
.RGB = RGB(0, 250, 0) 'grün
Case Is = (Current_Date)
.RGB = RGB(0, 250, 0) 'grün
Case Is = (Current_Date)
.RGB = RGB(0, 250, 0) 'grün
Case Is = (Current_Date)
.RGB = RGB(0, 250, 0) 'grün
Case Is = (Current_Date)
.RGB = RGB(0, 250, 0) 'grün
Case Is = (Current_Date)
.RGB = RGB(0, 250, 0) 'grün
Case Is = (Current_Date)
.RGB = RGB(0, 250, 0) 'grün
Case Is = (Current_Date)
.RGB = RGB(0, 250, 0) 'grün
Case Is = (Current_Date)
.RGB = RGB(0, 250, 0) 'grün
Case Is = (Current_Date)
.RGB = RGB(0, 250, 0) 'grün
Case Is

ggf. kann man auch die Prüfung unten zusammen fassen und in eine Schleife packen aber da sind bei AH die Shape 1 bis 3 nicht ein einer Reihe.
VG

Moin nochmal!
Also bzgl. der Daten solltest du beim Eintragen in das Blatt noch cdate() jeweils davorsetzen. DAnn wird es im Blatt auch als Datum eingetragen. Zuletzt war es nur als Text und wird dann vom Programm nicht als Datum erkannt.
HIer mal eine geänderte Beispieldatei - aber Achtung bin mir bei den Farben und Zeitabständen nicht sicher. Habe die Zeit mal rückwirkend genommen um zu testen, ob man noch in der Zeit ist (also ob der Termin nicht 80 Tage vor jetzt liegt). Ansonsten habe ich 3 der Shapes getauscht, damit die Reihenfolge stimmt. Das mit dem CDate beim Eintragen aus der USerform ist auch drin. Und dann habe ich das CHange mal gekürzt und geändert. Teste mal, ob das so wie gewollt arbeitet. Wie geschrieben, bei der Zeit kann es auch sein, dass es anders gemeint war, das kann man noch ändern. Musste mit den Daten spielen, die sind also nicht mehr wie zum Anfang.
https://www.herber.de/bbs/user/123625.xls
VG

Private Sub Worksheet_Change(ByVal Target As Range) Dim Current_Date As Date '** war String Dim Date_String As Date 'Aussprung beim löschen mehrerer Zellen!! If Target.Columns.Count > 1 Then Exit Sub 'Bei Eingaben vor Spalte AG Pgroamm Ende If Target.Columns 0 Then MsgBox "ungültige Eingabe" Target.Select: GoTo evon End If On Error GoTo evon 'Event ON!! Application.EnableEvents = False Current_Date = CDate(Date_String) ActiveCell.Value = Current_Date 'Cursor auf EingabeZelle zurücksetzen!! Target.Select '** diesen Teil unbedingt -VOR- End Sub setzen evon: 'Events immer On setzen!! Application.EnableEvents = True End Sub

Private Sub Worksheet_Change(ByVal Target As Range) Dim Current_Date As Date '** war String Dim Date_String As Date 'Aussprung beim löschen mehrerer Zellen!! If Target.Columns.Count > 1 Then Exit Sub On Error Resume Next Date_String = Target.Value 'war ActiveCell If Target.Value = Empty Then Target.Select: Exit Sub 'Abbruch bei ungültiger Eingabe If Err > 0 Then MsgBox "ungültige Eingabe" Target.Select: GoTo evon End If On Error GoTo evon 'Event ON!! Application.EnableEvents = False Current_Date = CDate(Date_String) ActiveCell.Value = Current_Date 'Cursor auf EingabeZelle zurücksetzen!! Target.Select

Beliebteste Forumthreads (12 Monate)

Fehler im Code ich komme nicht weiter

10
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Fehler im Code ich komme nicht weiter

10 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

10
Beiträge zum Forumthread

Beiträge zu diesem Forumthread