Dieses Forum nutzt Cookies
Dieses Forum verwendet Cookies, um deine Login-Informationen zu speichern, wenn du registriert bist, und deinen letzten Besuch, wenn du es nicht bist. Cookies sind kleine Textdokumente, die auf deinem Computer gespeichert werden. Die von diesem Forum gesetzten Cookies werden nur auf dieser Website verwendet und stellen kein Sicherheitsrisiko dar. Cookies aus diesem Forum speichern auch die spezifischen Themen, die du gelesen hast und wann du zum letzten Mal gelesen hast. Bitte bestätige, ob du diese Cookies akzeptierst oder ablehnst.

Ein Cookie wird in deinem Browser unabhängig von der Wahl gespeichert, um zu verhindern, dass dir diese Frage erneut gestellt wird. Du kannst deine Cookie-Einstellungen jederzeit über den Link in der Fußzeile ändern.

Fenster beim öffnen von Datei mit automatischer Datumsabfrage/-anzeige
#1
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!
Antworten Top
#2
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
Antworten Top
#3
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.
Antworten Top
#4
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
[-] Folgende(r) 1 Nutzer sagt Danke an Kuwer für diesen Beitrag:
  • Wurschdbrot
Antworten Top
#5
Lightbulb 
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
Antworten Top
#6
Hallo,

poste doch mal eine Beispielmappe.

Gruß Uwe
Antworten Top


Gehe zu:


Benutzer, die gerade dieses Thema anschauen: 1 Gast/Gäste