userforma timer eklenmesi

[hasan.doru]

herkese merhaba
userform üzerine timer eklenebilirmi.ekleniyorsa nereden ekleyebilirim.teşekkür ederim.

 

[baron07]

aşağıdaki kodu ilgili labele kopyala

Private Sub UserForm_Activate()
Do
DoEvents
Label14.Caption = Format(Now)
Loop
End Sub

kolay gelsin

 

[hasan.doru]

sayın baron07
gönderiğiniz kod işimi gördü.çok teşekkürler :hey:

 

[hsayar]

burada şimdiki zaman yerine geçen süre saniye cinsinden gösterilebilirmi

00:00:00 dan başlayacak

 

[hakanozgulderer]

Merhaba bende dün buna benzer soru sormuştum ama cevap alamadım benim istediğim belli bir saatte diğer form açılacak yardımlarınız için teşekkür

 

[ECYavuz]

Timer Örneği;

Sub timerMsg()
Dim alertTime
MsgBox "The alarm will go off in 3 seconds!"
alertTime = Now + TimeValue("00:00:03")
Application.OnTime alertTime, "msg"
End Sub

Sub msg()
MsgBox "Three Seconds is up!"
End Sub

 

[ECYavuz]

Hatta bi adet daha;

Sub Test()
MsgBox "A1'e bir değer girmek için 5 saniyeniz var."
Test2
End Sub

Sub Test2()
Static hr As Date
If hr <> Now - TimeValue("00:00:05") Then
hr = Now
Application.OnTime Now + TimeValue("00:00:05"), "Test2"
Else
If IsEmpty(Range("A1")) Then
MsgBox "Yaaaa..."
Else
MsgBox "Ge&#231;ti Can&#305;m..."
End If
End If
End Sub

 

[hsayar]

hocam tanm olarak istedi&#287;im &#351;u

MODUL

Sub Raporla()
'Dim wfTOPLA As WorksheetFunction:   Set wfTOPLA = WorksheetFunction.Sum
Dim wsRAPR, wsOZET As Worksheet:         Set wsRAPR = Sheets("2007"):         Set wsOZET = Sheets("ozet")

UserForm1.Show False:    DoEvents
Application.Calculation = xlCalculationManual
For sat = 8 To 140
topla = 0
    If wsOZET.Cells(sat, "K") <> "" And _
       wsOZET.Cells(sat, "R") <> "" And _
       wsOZET.Cells(sat, "F") <> "" Then
        For rpr = 5 To 2262
            If wsRAPR.Cells(rpr, "E") = wsOZET.Cells(sat, "K") And _
               wsRAPR.Cells(rpr, "F") = wsOZET.Range("C4") And _
               wsRAPR.Cells(rpr, "B") >= wsOZET.Range("I4") And _
               wsRAPR.Cells(rpr, "B") <= wsOZET.Range("M4") And _
               UCaseTr(wsRAPR.Cells(rpr, "G")) = UCaseTr(wsOZET.Cells(sat, "R")) And _
               UCaseTr(wsRAPR.Cells(rpr, "I")) = UCaseTr(wsOZET.Cells(sat, "F")) Then
               topla = topla + wsRAPR.Cells(rpr, "J")
            End If
        Next rpr
        wsOZET.Cells(sat, "M") = topla
    Else
        wsOZET.Cells(sat, "M") = ""
    End If
Next sat
Application.Calculation = xlCalculationAutomatic
Unload UserForm1
MsgBox "Veri Aktar&#305;m&#305; Ba&#351;ar&#305; ile tamamland&#305;."
End Sub
Function UCaseTr(ByVal metin As String)
    UCaseTr = UCase(Replace(Replace(metin, "&#305;", "I"), "i", "&#304;"))
End Function

ise userformda
label2 de ge&#231;en s&#252;re nas&#305;l g&#246;sterilir.

 

[ECYavuz]

Application.Calculation = xlCalculationManual
Start=Timer
For sat = 8 To 140
...........
..........
..........
Next sat
Application.Calculation = xlCalculationAutomatic
Finish=Timer

Label1.Caption = "Toplam Süre :" & Finish-Start & " Saniyedir."

Şeklinde denenebilir.