Ereignisprozedur bei Monatswechsel

Bild

Betrifft: Ereignisprozedur bei Monatswechsel von: Korl
Geschrieben am: 04.02.2005 20:31:30

Hallo,

in meinem Tabellenblatt "Stamm" habe ich für die Zelle "F3" eine Gültigkeit für eine Liste festgelegt mit der Anzeige für Monat mit Jahr.

Ist es nun möglich eine Ereignisprozedur anzulegen, die folgendes ausführen soll.

Bei Wechsel des Monats, soll in der Tabelle "Stamm", im Bereich "B7:C140", der Inhalt entfernt werden.
Und, in der Tabelle "Liste", im Bereich "A3:G160", Alles entfernt werden.

Ich habe leider nicht so die Ahnung mit VBA, kann da jemand helfen?

Gruß Korl

Bild


Betrifft: AW: Ereignisprozedur bei Monatswechsel von: Josef Ehrensberger
Geschrieben am: 04.02.2005 20:51:14

Hallo Korl!

Kleine Vorarbeit!

Gehe auf "Einfügen" > "Namen" > "Definieren".

Schreib unter "Namen in der Arbeitsmappe" "oldDat", und unter
"Bezieht sich auf" =38387 ! (Ist heute)

Dann füge diesen Code in "DieseArbeitsmappe"

Private Sub Workbook_Open()
   If Month(Right(ThisWorkbook.Names("oldDat").Value, 5)) < Month(Date) Then
   Sheets("Stamm").Range("B7:C140").ClearContents
   Sheets("Liste").Range("A3:G160").Clear
   ThisWorkbook.Names("oldDat").Value = CDbl(Date)
   End If
End Sub



Gruß Sepp

P.S.: Rückmeldung nicht vergessen!


Bild


Betrifft: AW: Ereignisprozedur bei Monatswechsel von: Korl
Geschrieben am: 04.02.2005 21:21:32

Hallo Sepp,

Schön, das Du mir mal wieder unter die Arme greifst.

Ich habe den Namen "oldDat" "=38387" vergeben und den Code dort hingesetzt wo er hin soll. Anschließend das File gespeichert, geschlossen und neu aufgerufen, aber nichts,
alles ruht.

Frage: Bindest Du das aktuelle Datum "heute()" in den Code ein?

Eigentlich möchte ich nur wenn in der Tabelle "Stamm" Zelle "F3" der Monat gewechselt wird. Also, immer wenn ein anderer Inahlt in der Zelle steht als vorher.

Lässt sich dieses so einrichten?

Gruß Korl


Bild


Betrifft: AW: Ereignisprozedur bei Monatswechsel von: Josef Ehrensberger
Geschrieben am: 04.02.2005 21:52:12

Hallo Korl!

Da hab ich die Frage falsch interpretiert!

Ich dachte bei einem "wirklichen" Monatswechsel!



'Allgemeines Modul
Dim oldVal As Variant
'DieseArbeitsmappe
Private Sub Workbook_Open()
oldVal = Sheets("Stamm").Range("F3")
End Sub
'Tabelle "Stamm"
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



Gruß Sepp

P.S.: Rückmeldung nicht vergessen!


Bild


Betrifft: AW: Ereignisprozedur bei Monatswechsel von: Korl
Geschrieben am: 04.02.2005 22:16:38

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


Bild


Betrifft: AW: Ereignisprozedur bei Monatswechsel von: Josef Ehrensberger
Geschrieben am: 04.02.2005 22:24:15

Hallo Korl!

Kein Problem!

Das "Exit Sub" war in deinem Code fehl am Platz!

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
On Error GoTo err
Set Bereich = Range("B7", "B132")
  If Not Intersect(Target, Bereich) Is Nothing Then
    Application.EnableEvents = False
    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
   If Target.Address = "$F$3" Then
      If Target <> oldVal Then
      Application.EnableEvents = False
      Range("B7:C140").ClearContents
      Sheets("Liste").Range("A3:G160").Clear
      oldVal = Target
      End If
   End If
err:
Application.EnableEvents = True
End Sub



Gruß Sepp

P.S.: Rückmeldung nicht vergessen!


Bild


Betrifft: Danke, Sepp, klappt prima!! von: Korl
Geschrieben am: 04.02.2005 22:37:49

Hallo Sepp,

es läuft tadellos und sogar nach meinen Vorstellungen!

Hab Dank dafür!!!

Gruß Korl


 Bild

Beiträge aus den Excel-Beispielen zum Thema "Ereignisprozedur bei Monatswechsel"