Celwaarde + opmaak overnemen in userform

[TonRo]

Beste deskundigen,

Ik heb in jullie forum code gevonden om een counter af te laten tellen. Dit werkt goed. Alleen ik wil graag de waarde van cel A1 op een userform zichbaar krijgen.

Ik gebruik daar nu een label voor en geef aan dat de label.caption de waarde van cel A1 heeft. Op zich werkt dit alleen de opmaak krijg ik niet goed.

Weet iemand van jullie hier een oplossing voor of moet ik iets anders gebruiken ipv een label. Bekijk bijgevoegd voorbeeld.

Alvast bedankt voor het meedenken.

Met vriendelijke groet,

TonRoBekijk bijlage CountdownAftel.xls

 

[pasan]

Moet de waarde in cel A1 weergegeven worden? zo niet dan probeer deze eens

Public NextTime As Date
Public EndTime As Date


Sub StartCount()
EndTime = Now + TimeValue("00:00:05")
NextTime = Now + TimeValue("00:00:00")
UserForm1.Label1.Caption = Format(EndTime - Now, "s")
Application.OnTime NextTime, "Continuecount"
End Sub


Sub Continuecount()
NextTime = Now + TimeValue("00:00:01")
If EndTime - Now < 0 Then Cel
UserForm1.Label1.Caption = Format(EndTime - Now, "s")
Application.OnTime NextTime, "Continuecount"
End Sub


Sub Cel()
Unload UserForm1
End
End Sub

 

[TonRo]

Hallo Pasan,

Dit werkt in principe al wel ziet er veel belovend uit en ik heb cel A1 niet nodig, alleen nu telt hij bijv af van 5 sec naar nul. Wat als ik nu van 5:00 (5 minuten) naar nul wil aftellen, wat moet ik dan invullen.

Alvast bedankt,

TonRo

 

[pasan]

dit heb ik er van gemaakt

Option Explicit

Public NextTime As Date
Public EndTime As Date
Public MyTime As Date

Sub StartCount()
EndTime = Now + TimeValue("00:05:00")
NextTime = Now + TimeValue("00:00:00")
UserForm1.Label1.Caption = Format(EndTime - Now, "hh:mm:ss")
Application.OnTime NextTime, "Continuecount"
End Sub

Sub Continuecount()
NextTime = Now + TimeValue("00:00:01")
If EndTime - Now < 0 Then Cel
MyTime = Format(EndTime - Now, "hh:mm:ss")
UserForm1.Label1.Caption = Minute(MyTime) & ":" & Second(MyTime)
Application.OnTime NextTime, "Continuecount"
End Sub

Sub Cel()
Unload UserForm1
End
End Sub

als je wil voorkomen dat de userform voortijdig wordt afgesloten

Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
If CloseMode = vbFormControlMenu Then Cancel = True
End Sub

 

[pasan]

Een andere manier
bij deze moet je een Textbox plaatsen op de userform met de naam "Textbox1"
Het aftellen wordt nu geactiveerd op de Change event van deze textbox1

Dim CM As Boolean
Dim MyTime As Date
Dim NextTime As Date


Private Sub TextBox1_Change()
 MyTime = TimeSerial(Hour(NextTime), Minute(NextTime), Second(NextTime) - 1)
 NextTime = MyTime
 Label1.Caption = IIf(Minute(NextTime) = 0, Second(NextTime), Minute(NextTime) & ":" & Second(NextTime))
 If NextTime < 0 Then CM = True: Unload Me
End Sub


Private Sub UserForm_Activate()
 Do
  If CM = True Then Exit Sub
   TextBox1 = Format(Now, "hh:mm:ss")
  DoEvents
 Loop
End Sub


Private Sub Userform_Initialize()
 Label1 = TimeValue("05:01")
 NextTime = TimeValue("00:05:01")
 TextBox1.Visible = False                   'textbox is onzichtbaar
End Sub


Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
If CloseMode = vbFormControlMenu Then Cancel = True
End Sub

 

[TonRo]

Hallo Pasan,

Allereerst sorry voor mijn late reactie, maar we hebben te maken met een sterfgeval in de familie waar ik de komende dagen nog wel meer mee bezig zal zijn, dus ik kan niet beloven dat ik iedere keer snel kan reageren.

Je 2e optie met de textbox ziet er ook goed uit en deze kan ik tussentijds onderbreken door de macro te stoppen.

Dit lukt niet bij de 1e optie met het label, wanneer ik deze onderbreek flipt hij helemaal en blijft maar doorgaan. (Is niet meer te stoppen)

Alleen wa me bij allebei op viel is dat de tijd niet steeds correct wordt weergegeven, hij begint met 5:0 omdat als volgende 4:59 neer te zetten en af te tellen, na 4:10 vervolgd hij met 4:9 - 4:8 - 4:7 enz dus de 0 die er tussen hoort te staan is er niet. Hoe kan dit opgelost worden, op deze manier ziet het er raar uit.

Hopelijk weet je hier og een oplossing voor en iets om tussentijds te kunen stoppen.

Groeten,

TonRo

 

[pasan]

probeer deze eens
Als je nu op het rode kruisje drukt stop de telling en sluit de form

Dim CM As Boolean
Dim MyTime As Date
Dim NextTime As Date
Dim TelM As Integer
Dim TelS As Integer
Dim minuut As String
Dim seconde As String

Private Sub TextBox1_Change()
 MyTime = TimeSerial(Hour(NextTime), Minute(NextTime), Second(NextTime) - 1)
 NextTime = MyTime
 TelM = Len(Minute(NextTime))
 TelS = Len(Second(NextTime))
 minuut = IIf(TelM = 1, "0" & Minute(NextTime), Minute(NextTime))
 seconde = IIf(TelS = 1, "0" & Second(NextTime), Second(NextTime))
 Label1.Caption = minuut & ":" & seconde
 If NextTime < 0 Then CM = True: Unload Me
End Sub


Private Sub UserForm_Activate()
 Do
  If CM = True Then Exit Sub
   TextBox1 = Format(Now, "hh:mm:ss")
  DoEvents
 Loop
End Sub


Private Sub Userform_Initialize()
 Label1 = TimeValue("05:01")
 NextTime = TimeValue("00:05:01")
 TextBox1.Visible = False
End Sub


Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
CM = True: Unload Me
End Sub

 

[TonRo]

Hallo Pasan,

Dit werkt geweldig, ik heb zelf al ontdekt hoe ik nu de voorloop 0 kan verwijderen zodat er niet 05:00 komt te staan maar 5:00.

Alleen nu had ik nog een vraagje? Is het mogelijk dat ik begin met een groene achtergrond en wanneer er nog 1 minuut over is de achtergrond rood wordt, of er een geluidje komt, wat zijn hierin de mogelijkheden.

Groet,

TonRo

 

[pasan]

eerst dus de kleur groen bij Label1.Backcolor

Private Sub Userform_Initialize()
 Label1 = TimeValue("01:11")
 NextTime = TimeValue("00:01:11")
 TextBox1.Visible = False
 Label1.BackColor = RGB(34, 139, 34)
End Sub

bij Textbox1 Change zet je dan:

Private Sub TextBox1_Change()
 MyTime = TimeSerial(Hour(NextTime), Minute(NextTime), Second(NextTime) - 1)
 NextTime = MyTime
 TelS = Len(Second(NextTime))
 seconde = IIf(TelS = 1, "0" & Second(NextTime), Second(NextTime))
 Label1.Caption = Minute(NextTime) & ":" & seconde
 If TimeValue(Label1) < ("01:00") Then Label1.BackColor = RGB(255, 69, 0)
 If TimeValue(Label1) < ("00:20") Then Label1.BackColor = RGB(255, 0, 0): Beep     
 If NextTime < 0 Then CM = True: Unload Me
End Sub

Als het If statement "TimeValue(Label1)< ("00:20")" waar is dan pas wordt de "Beep" ook uitgevoerd.

 

[TonRo]

Hallo Pasan,

We komen steeds dichter in de buurt, ik heb het even aangepast zodat hij bij de if statements vergelijkt met 1:00 en 0:20 ipv 01:00 en 00:20.

Dit werkt allemaal perfect alleen de beep doet hij niet, hoe kan ik dit nog oplossen.

Groet TonRo

 

[pasan]

de kleuren werken wel?

 

[pasan]

als ik de tijdwaarden aanpas zoals jij beschrijft werken de kleuren ook niet

 

[TonRo]

Hallo Pasan,

Bij mij werken de kleuren wel, ik heb hiervoor ook in de Private sub userform_initialize(), ook Label1 = TimeValue("1:21") staan dus ook heb ik hier de 0 die jij ervoor had staan verwijderd.

Hopelijk help dit je en kun je me dan toch verder helpen.

Groet,

TonRo

 

[pasan]

zet jou code is hier neer

 

[TonRo]

Hallo Pasan,

hierbij het bestand toegevoegd zodat je mijn code kunt zien die ik tot nu toe heb.Bekijk bijlage CountdownAftel.xls

Groet, TonRo

 

[pasan]

probeer deze eens

 

[TonRo]

Hallo Pasan,

Nu werkt het niet meer, hij telt wel af maar hij veranderd niet meer van kleur laat staan dat er geluid hoorbaar is.

Je hebt wat dingen weggelaten die denk ik toch nodig waren.

Groet,

TonRo

 

[pasan]

dit is jou eigen bestand met aangepaste code voor het geluid

 

[TonRo]

Hallo Pasan,

Alles werkt weer zo als daarstraks alleen nog steeds geen geluid.

Misschien weet je nog een optie.

Groet,

TonRo

 

[pasan]

kan het zijn dat je windows geluiden uit hebt staan?
CONFIGURATIESCHERM --> GELUIDEN EN AUDIOAPPARATEN