Counter als Userform beim starten
13.08.2013 16:38:49
mikey
Hallo
ich würde gerne eine userform in vollbild beim starten meines Excel files erstellen.
Den code dazu habe ich schon gefunden. Die beispiel datei habe ich auch hochgeladen.
Möchte keine Abfragen und das es nicht möglich ist die Userform mit x oben zu schließen oder abzubrechen.
Vielleicht könnt ihr mir da weiterhelfen.
https://www.herber.de/bbs/user/86836.xlsm
'In DieseArbeitsmappe
Option Explicit
Private Sub Workbook_Open()
Application.Visible = False
UserForm1.Show
End Sub
'---------------------------------------------------
'---------------------------------------------------
'In ein Modul
Option Explicit
Declare Function GetSystemMetrics Lib "user32" (ByVal nIndex As Long) As Long
Public Const SM_CXSCREEN = 0
Public Const SM_CYSCREEN = 1
'---------------------------------------------------
'---------------------------------------------------
'In Dekleration der Userform
Private Sub UserForm_Initialize()
Me.Left = 0
Me.Top = 0
Me.Height = GetSystemMetrics(SM_CYSCREEN) * 0.75
Me.Width = GetSystemMetrics(SM_CXSCREEN) * 0.75
End Sub
Nur beim Counter bin ich restlos überfordert.
Ich möchte einfach das die Userform erscheint und dort von 30 Sekunden rückgezählt wird.
Dann schließt sich die Userform automatisch, man sollte sie nicht abbrechen können.
anbei der code den ich gefunden habe.
Option Explicit
Dim i As Date
Dim lngZaehler As Long
Dim Erledigt As Double
Dim zeit1, zeit2, zeit3 As Date
Dim Rundung, Ingtext As String
Dim IngZeit As Date
Dim IngAnzahl%, h%, IngStart%
Sub Start()
UserForm1.Label1.Width = 0
UserForm1.Show
End Sub
Sub CountDown()
Sheets("Tabelle1").Select
If h = 0 Then
IngZeit = InputBox("Bitte Länge des Countdowns eintragen!" & Chr(10) & "Standartwert entsricht 15 Minuten.", "Bitte Länge im Format
IngAnzahl = InputBox("Wie oft soll der Countdown laufen?" & Chr(10) & "Standartwert entspricht 2 Durchläufe.", "Bitte nur ganze Zahlen", "2") + 1
Ingtext = "Möchten Sie abbrechen?" & Chr(10) & "Ihre Einstellungen:" & Chr(10) & IngAnzahl - 1 & " Durchläufe á " & IngZeit & " Stunden."
If MsgBox(Ingtext, vbYesNo) = vbYes Then
Exit Sub
End If
End If
zeit1 = Time
zeit2 = zeit1 + IngZeit
If h 0 Then
IngAnzahl = h
End If
For h = IngAnzahl To 1 Step -1
If h = 1 Then
Exit Sub
ElseIf h >= 2 And UserForm1.Visible = False Then
UserForm1.Show
End If
For i = zeit1 To zeit2 Step ("00:00:01")
zeit3 = -(TimeValue(i) - TimeValue(zeit2))
lngZaehler = lngZaehler + 1
Erledigt = (zeit2 - i) / (zeit2 - zeit1)
UserForm1.Label2.Caption = "Die Zeit läuft!" & Chr(10) & " Restzeit: " & zeit3
With UserForm1
If .Caption Format(Erledigt, "0%") Then
.Caption = Format(Erledigt, "0%") & " der Zeit übrig!"
.Label1.Width = Erledigt * (.Frame1.Width - 10)
End If
End With
If i > Time Then
Application.Wait (i)
End If
DoEvents
Next
Unload UserForm1
UserForm1.Hide
Next
h = 0
'***hier kann man weitere Funktionen einbauen nach dem Ablauf des Timers!***
End Sub