Fenster beim öffnen von Datei mit automatischer Datumsabfrage/-anzeige

[Wurschdbrot]

Hallo zusammen,

ich brauche dringend eure Hilfe. Folgendes versuche ich -leider erfolglos- seit Tagen umzusetzen:

Tabellenname: Angebotsverfolgung

Beim Öffnen meiner Datei soll ein Fenster (Userbox1) erscheinen, in dem angezeigt wird:

1. Daten aus Spalte A, Daten aus Spalte B und Daten aus Spalte J, wenn in Spalte K, L oder M (Datumsformat) das Datum dem heutigen entspricht
2. Daten aus Spalte A, Daten aus Spalte B und Daten aus Spalte J, wenn in Spalte K, L oder M (Datumsformat) das Datum in der Vergangenheit liegt

Die beim Versuch mit F5 erscheint immerhin schon das Fenster ohne Fehlermeldung, aber Daten stehen keine drin. Und wenn ich die Datei öffne, passiert Garnichts.

Hier mein Code Listbox1:

Option Explicit
Private Sub btn_OK_Click()
    Unload Me
End Sub
Private Sub ListBox1_Click()
Dim iRow As Long
iRow = ListBox1.List(ListBox1.ListIndex, 0)
Sheets("Angebotsverfolgung").Range("A" & iRow & ":N" & iRow).Select
End Sub
Private Sub ListBox2_Click()
Dim iRow As Long
iRow = ListBox2.List(ListBox2.ListIndex, 0)
Sheets("Angebotsverfolgung").Range("A" & iRow & ":N" & iRow).Select
End Sub

Private Sub UserForm1_Initialize()
Dim rng As Range
ListBox1.Clear
ListBox2.Clear
For Each rng In Sheets("Angebotsverfolgung").Range("K4:M200")
    If (rng.Value - Int(Now()) = 1) Then
        ListBox1.AddItem
        ListBox1.List(ListBox1.ListCount - 1, 0) = rng.Row
        ListBox1.List(ListBox1.ListCount - 1, 1) = Cells(rng.Row, 1).Value
        ListBox1.List(ListBox1.ListCount - 1, 2) = Cells(rng.Row, 2).Value
        ListBox1.List(ListBox1.ListCount - 1, 3) = Cells(rng.Row, 10).Value
    ElseIf (rng.Value - Int(Now()) < 1) Then
        ListBox2.AddItem
        ListBox2.List(ListBox2.ListCount - 1, 0) = rng.Row
        ListBox2.List(ListBox2.ListCount - 1, 1) = Cells(rng.Row, 1).Value
        ListBox2.List(ListBox2.ListCount - 1, 2) = Cells(rng.Row, 2).Value
        ListBox2.List(ListBox2.ListCount - 1, 3) = Cells(rng.Row, 10).Value
Next rng
If ListBox1.ListCount = 0 And ListBox2.ListCount = 0 Then
    UserForm1.Hide
    Application.OnTime Now + TimeValue("00:00:03"), "DieseArbeitsmappe.Beenden"
Else
    Me.Show
End If
End Sub
Private Sub UserForm_Click()
End Sub



Workbook Diese Arbeitsmappe:

Private Sub Workbook_Open()
    On Error Resume Next
    Load UserForm1
End Sub
Public Sub Beenden()
    Unload UserForm1
End Sub



Ich bin schon stolz, dass ich es soweit geschafft habe, wenn ihr mir mit dem letzten Schliff noch helfen könntet, wäre ich echt dankbar!!! :17:

Vielen Dank schon mal!

[Kuwer]

Hallo,

vielleicht so:

Private Sub UserForm1_Initialize()
 Dim rng As Range
 For Each rng In Sheets("Angebotsverfolgung").Range("K4:M200")
   If CLng(rng.Value) = Date Then
       ListBox1.AddItem rng.Row
       ListBox1.List(ListBox1.ListCount - 1, 1) = Cells(rng.Row, 1).Value
       ListBox1.List(ListBox1.ListCount - 1, 2) = Cells(rng.Row, 2).Value
       ListBox1.List(ListBox1.ListCount - 1, 3) = Cells(rng.Row, 10).Value
   ElseIf CLng(rng.Value) < Date Then
       ListBox2.AddItem rng.Row
       ListBox2.List(ListBox2.ListCount - 1, 1) = Cells(rng.Row, 1).Value
       ListBox2.List(ListBox2.ListCount - 1, 2) = Cells(rng.Row, 2).Value
       ListBox2.List(ListBox2.ListCount - 1, 3) = Cells(rng.Row, 10).Value
   End If
 Next rng
 If ListBox1.ListCount = 0 And ListBox2.ListCount = 0 Then
   Unload Me
 End If
End Sub

'Workbook Diese Arbeitsmappe:

Private Sub Workbook_Open()
   UserForm1.Show
End Sub

Gruß Uwe

[Wurschdbrot]

Hi Uwe,

vielen Dank, das Fenster öffnet sich jetzt automatisch aber es lässt sich nicht mehr über meinen OK-Button schließen und die Daten werden noch immer nicht gezogen.

[Kuwer]

Hallo,

am OK-Button hatte ich keine Änderung vorgeschlagen.
Wenn keine Daten gefunden werden, stehen halt keine passenden Daten in Spalte K. Am jetzigen Code liegt es jedenfalls nicht.

Gruß Uwe

[Wurschdbrot]

OK, den Button hab ich hinbekommen, hab wohl irgendwas nicht mit kopiert oder so.

Ich habe Daten in der betreffenden Spalte. Im Datumsformat. Bisher sowohl durch manuelle Eingabe als auch durch Formel. Es kommen einfach keine Daten an. :s

[Kuwer]

Hallo,

poste doch mal eine Beispielmappe.

Gruß Uwe