A zkusil jsi něco dělat v sešitě, když máš spuštěné makro? Asi to moc dobře nejde, že?
Aktualizace času co sekundu je hezká věc, dokud tě co sekundu nebude blokovat.
Běžící hodiny v Excelu
Znáte pravidla?
Tipy a triky ve Windows XP
Návody: HijackThis, MWAV, CCleaner (THX to mijaja)
Problémy, které chcete vyřešit pište sem do fóra. Neposílejte je emailem ani po ICQ!
Tipy a triky ve Windows XP
Návody: HijackThis, MWAV, CCleaner (THX to mijaja)
Problémy, které chcete vyřešit pište sem do fóra. Neposílejte je emailem ani po ICQ!
Kód: Vybrat vše
Sub VlozCas()
Cells(1,1) = Time()
Application.OnTime EarliestTime:= Now + TimeValue("00:00:01"), Procedure:= "VlozCas"
Cells(1,2) = Now + TimeValue("00:00:01")
End Sub
Sub Konec()
Application.OnTime EarliestTime:= Cells(1, 2), Procedure:= "VlozCas", Schedule:= false
End Sub
Tyhle dve procedury jsem vlozil do modulu sesitu, jeste jsem na list placnul dve tlacitka. Prvnim (nalinkovanym na proceduru VlozCas) se to spusti a v bunce A1 po cca sekunde se objevuje novy, aktualni cas. Bunka A2 je pomocna, pomoci ni se "Timer" vypina. Druhe tlacitko, nalikovane na proceduru Konec, casovac vypina... Nezabyval jsem se tim do vsech detailu, nicmene letmo vim, ze v Excelu lze pracovat normalne, lze normalne kopirovat a presouvat bunky. Lze taky normalne pracovat s Win (spoustet jine aplikace, prepinat se mezi nimi atd.). Funguje to dokonce i kdyz zamknu PC a nasledne odemknu...
Takze dle meho nazoru tenhle mikrokod resi presne pozadavek zadavatele...
Vypadá to dobře. Gratuluji.
Jak je vidět, tak nic není nemožné.
Jak je vidět, tak nic není nemožné.
Znáte pravidla?
Tipy a triky ve Windows XP
Návody: HijackThis, MWAV, CCleaner (THX to mijaja)
Problémy, které chcete vyřešit pište sem do fóra. Neposílejte je emailem ani po ICQ!
Tipy a triky ve Windows XP
Návody: HijackThis, MWAV, CCleaner (THX to mijaja)
Problémy, které chcete vyřešit pište sem do fóra. Neposílejte je emailem ani po ICQ!
- Střelec 5
- Level 1.5
- Příspěvky: 122
- Registrován: srpen 07
- Bydliště: Východní Čechy
- Pohlaví:
- Stav:
Offline
Zdravím pánové,mám problém ale nevím kde je chyba. S počítačem to moc neumím a už vůbec ne s makry a excelem i když to zkouším. Našel jsem na tomto fóru tudle vynikající věc tj.čas do listu excelu přes makra, ale nějak se mi to nedaří. Zkopíroval jsem celé zadání do sešitu excelu a přiřadil tlačítka k makrum.Čas vloží ale hlásí to chybu.Vyzkoušel jsem vše co mě napadlo ,ale někde dělám chybu.
Střelec 5
- mike007
- Master Level 7.5
- Příspěvky: 5860
- Registrován: srpen 07
- Bydliště: Pardubice
- Pohlaví:
- Stav:
Offline
- Kontakt:
ta chyba je snad jasná,ne? Excelový dokument zkouška čas.xls nelze nalézt.
Nejlepší hra je Excel!
• Pravidla fóra PC-help • Jak označit téma za vyřešené
»»»»»»»»»»»»»»»»»»»»»»»
UPOZORNĚNÍ - můj Skype, Soukromé zprávy či email neslouží jako tech. podpora.
Dotazy pište do fóra. Od toho tu je.
• Pravidla fóra PC-help • Jak označit téma za vyřešené
»»»»»»»»»»»»»»»»»»»»»»»
UPOZORNĚNÍ - můj Skype, Soukromé zprávy či email neslouží jako tech. podpora.
Dotazy pište do fóra. Od toho tu je.
- mike007
- Master Level 7.5
- Příspěvky: 5860
- Registrován: srpen 07
- Bydliště: Pardubice
- Pohlaví:
- Stav:
Offline
- Kontakt:
Jinak co se týče hodin v excelu, tak tady máte docela pěkné hodiny s odpočtem : http://www.bastleni.com/uploader/data/hodiny.zip Přepočet se dá zastavit nebo se dá v makru nastavit po jaké době se má sešit zaktualizovat. Opravdu pěkné.
To si někdo vyhrál. I love Excel too...
To si někdo vyhrál. I love Excel too...
Nejlepší hra je Excel!
• Pravidla fóra PC-help • Jak označit téma za vyřešené
»»»»»»»»»»»»»»»»»»»»»»»
UPOZORNĚNÍ - můj Skype, Soukromé zprávy či email neslouží jako tech. podpora.
Dotazy pište do fóra. Od toho tu je.
• Pravidla fóra PC-help • Jak označit téma za vyřešené
»»»»»»»»»»»»»»»»»»»»»»»
UPOZORNĚNÍ - můj Skype, Soukromé zprávy či email neslouží jako tech. podpora.
Dotazy pište do fóra. Od toho tu je.
martinb:
autor: Jiří Číhař
1) pojmenujte buňku, ve které se má zapisovat čas, názvem - "hodiny"
2) zapiště do modulu listu kód pro spuštění časovače při aktivaci listu:
Private Sub Worksheet_Activate()
Call StartClock
End Sub
Private Sub Worksheet_Deactivate()
Call StopClock
End Sub
3) vložte do modulu kódu program... ( viz VBE)
----------------------------------------------------------------
Option Explicit
Private Declare Function FindWindow Lib "user32" _
Alias "FindWindowA" _
(ByVal lpClassName As String, _
ByVal lpWindowName As String) As Long
Private Declare Function SetTimer Lib "user32" _
(ByVal hwnd As Long, _
ByVal nIDEvent As Long, _
ByVal uElapse As Long, _
ByVal lpTimerFunc As Long) As Long
Private Declare Function KillTimer Lib "user32" _
(ByVal hwnd As Long, _
ByVal nIDEvent As Long) As Long
Private Declare Function GetCurrentVbaProject Lib "vba332.dll" _
Alias "EbGetExecutingProj" _
(hProject As Long) As Long
Private Declare Function GetFuncID Lib "vba332.dll" _
Alias "TipGetFunctionId" _
(ByVal hProject As Long, _
ByVal strFunctionName As String, _
ByRef strFunctionID As String) As Long
Private Declare Function GetAddr Lib "vba332.dll" _
Alias "TipGetLpfnOfFunctionId" _
(ByVal hProject As Long, _
ByVal strFunctionID As String, _
ByRef lpfnAddressOf As Long) As Long
Private WindowsTimer As Long
Sub StartClock()
Range("hodiny").Value = Format(Now, "Long Time")
fncWindowsTimer 1000
End Sub
Sub StopClock()
fncStopWindowsTimer
End Sub
Private Function fncWindowsTimer(TimeInterval As Long) As Boolean
Dim WindowsTimer As Long
WindowsTimer = 0
'if we are in Excel2000 or above use the
'built-in AddressOf operator to get a pointer to the
'callback function
If Val(Application.Version) > 8 Then
WindowsTimer = SetTimer(hwnd:=FindWindow("XLMAIN", Application.Caption), _
nIDEvent:=0, _
uElapse:=TimeInterval, _
lpTimerFunc:=AddrOf_cbkCustomTimer)
Else 'use K.Getz & M.Kaplan function to get a pointer
WindowsTimer = SetTimer(hwnd:=FindWindow("XLMAIN", Application.Caption), _
nIDEvent:=0, _
uElapse:=TimeInterval, _
lpTimerFunc:=AddrOf("cbkCustomTimer"))
End If
fncWindowsTimer = CBool(WindowsTimer)
End Function
Private Function fncStopWindowsTimer()
KillTimer hwnd:=FindWindow("XLMAIN", Application.Caption), _
nIDEvent:=WindowsTimer
End Function
Private Function cbkCustomTimer(ByVal Window_hWnd As Long, _
ByVal WindowsMessage As Long, _
ByVal EventID As Long, _
ByVal SYSTEMTIME As Long) As Long
Dim CurrentTime As String
On Error Resume Next
Range("hodiny").Value = Format(Now, "Long Time")
End Function
Private Function AddrOf(CallbackFunctionName As String) As Long
'AddressOf operator replacement for Office97 VBA
'Authors: Ken Getz and Michael Kaplan
'
'declaration of local variables
Dim aResult As Long
Dim CurrentVBProject As Long
Dim strFunctionID As String
Dim AddressOfFunction As Long
Dim UnicodeFunctionName As String
'
'convert the name of the function to Unicode system
UnicodeFunctionName = StrConv(CallbackFunctionName, vbUnicode)
'
'if the current VBProjects exists...
If Not GetCurrentVbaProject(CurrentVBProject) = 0 Then
'...get the function ID of the callback function, based on its
'unicode-converted name, in order to ensure that it exists
aResult = GetFuncID(hProject:=CurrentVBProject, _
strFunctionName:=UnicodeFunctionName, _
strFunctionID:=strFunctionID)
'if the function exists indeed ...
If aResult = 0 Then
'...get a pointer to the callback function based on
'the strFunctionID argument of the GetFuncID function
aResult = GetAddr(hProject:=CurrentVBProject, _
strFunctionID:=strFunctionID, _
lpfnAddressOf:=AddressOfFunction)
'if we've got the pointer pass it to the result
'of the function
If aResult = 0 Then
AddrOf = AddressOfFunction
End If
End If
End If
End Function
Private Function AddrOf_cbkCustomTimer() As Long
'Office97 VBE does not recognise the AddressOf operator;
'however, it does not raise a compile-error either...
AddrOf_cbkCustomTimer = vbaPass(AddressOf cbkCustomTimer)
End Function
Private Function vbaPass(AddressOfFunction As Long) As Long
vbaPass = AddressOfFunction
End Function
autor: Jiří Číhař
1) pojmenujte buňku, ve které se má zapisovat čas, názvem - "hodiny"
2) zapiště do modulu listu kód pro spuštění časovače při aktivaci listu:
Private Sub Worksheet_Activate()
Call StartClock
End Sub
Private Sub Worksheet_Deactivate()
Call StopClock
End Sub
3) vložte do modulu kódu program... ( viz VBE)
----------------------------------------------------------------
Option Explicit
Private Declare Function FindWindow Lib "user32" _
Alias "FindWindowA" _
(ByVal lpClassName As String, _
ByVal lpWindowName As String) As Long
Private Declare Function SetTimer Lib "user32" _
(ByVal hwnd As Long, _
ByVal nIDEvent As Long, _
ByVal uElapse As Long, _
ByVal lpTimerFunc As Long) As Long
Private Declare Function KillTimer Lib "user32" _
(ByVal hwnd As Long, _
ByVal nIDEvent As Long) As Long
Private Declare Function GetCurrentVbaProject Lib "vba332.dll" _
Alias "EbGetExecutingProj" _
(hProject As Long) As Long
Private Declare Function GetFuncID Lib "vba332.dll" _
Alias "TipGetFunctionId" _
(ByVal hProject As Long, _
ByVal strFunctionName As String, _
ByRef strFunctionID As String) As Long
Private Declare Function GetAddr Lib "vba332.dll" _
Alias "TipGetLpfnOfFunctionId" _
(ByVal hProject As Long, _
ByVal strFunctionID As String, _
ByRef lpfnAddressOf As Long) As Long
Private WindowsTimer As Long
Sub StartClock()
Range("hodiny").Value = Format(Now, "Long Time")
fncWindowsTimer 1000
End Sub
Sub StopClock()
fncStopWindowsTimer
End Sub
Private Function fncWindowsTimer(TimeInterval As Long) As Boolean
Dim WindowsTimer As Long
WindowsTimer = 0
'if we are in Excel2000 or above use the
'built-in AddressOf operator to get a pointer to the
'callback function
If Val(Application.Version) > 8 Then
WindowsTimer = SetTimer(hwnd:=FindWindow("XLMAIN", Application.Caption), _
nIDEvent:=0, _
uElapse:=TimeInterval, _
lpTimerFunc:=AddrOf_cbkCustomTimer)
Else 'use K.Getz & M.Kaplan function to get a pointer
WindowsTimer = SetTimer(hwnd:=FindWindow("XLMAIN", Application.Caption), _
nIDEvent:=0, _
uElapse:=TimeInterval, _
lpTimerFunc:=AddrOf("cbkCustomTimer"))
End If
fncWindowsTimer = CBool(WindowsTimer)
End Function
Private Function fncStopWindowsTimer()
KillTimer hwnd:=FindWindow("XLMAIN", Application.Caption), _
nIDEvent:=WindowsTimer
End Function
Private Function cbkCustomTimer(ByVal Window_hWnd As Long, _
ByVal WindowsMessage As Long, _
ByVal EventID As Long, _
ByVal SYSTEMTIME As Long) As Long
Dim CurrentTime As String
On Error Resume Next
Range("hodiny").Value = Format(Now, "Long Time")
End Function
Private Function AddrOf(CallbackFunctionName As String) As Long
'AddressOf operator replacement for Office97 VBA
'Authors: Ken Getz and Michael Kaplan
'
'declaration of local variables
Dim aResult As Long
Dim CurrentVBProject As Long
Dim strFunctionID As String
Dim AddressOfFunction As Long
Dim UnicodeFunctionName As String
'
'convert the name of the function to Unicode system
UnicodeFunctionName = StrConv(CallbackFunctionName, vbUnicode)
'
'if the current VBProjects exists...
If Not GetCurrentVbaProject(CurrentVBProject) = 0 Then
'...get the function ID of the callback function, based on its
'unicode-converted name, in order to ensure that it exists
aResult = GetFuncID(hProject:=CurrentVBProject, _
strFunctionName:=UnicodeFunctionName, _
strFunctionID:=strFunctionID)
'if the function exists indeed ...
If aResult = 0 Then
'...get a pointer to the callback function based on
'the strFunctionID argument of the GetFuncID function
aResult = GetAddr(hProject:=CurrentVBProject, _
strFunctionID:=strFunctionID, _
lpfnAddressOf:=AddressOfFunction)
'if we've got the pointer pass it to the result
'of the function
If aResult = 0 Then
AddrOf = AddressOfFunction
End If
End If
End If
End Function
Private Function AddrOf_cbkCustomTimer() As Long
'Office97 VBE does not recognise the AddressOf operator;
'however, it does not raise a compile-error either...
AddrOf_cbkCustomTimer = vbaPass(AddressOf cbkCustomTimer)
End Function
Private Function vbaPass(AddressOfFunction As Long) As Long
vbaPass = AddressOfFunction
End Function
- Střelec 5
- Level 1.5
- Příspěvky: 122
- Registrován: srpen 07
- Bydliště: Východní Čechy
- Pohlaví:
- Stav:
Offline
mike007 píše:Jinak co se týče hodin v excelu, tak tady máte docela pěkné hodiny s odpočtem : http://www.bastleni.com/uploader/data/hodiny.zip Přepočet se dá zastavit nebo se dá v makru nastavit po jaké době se má sešit zaktualizovat. Opravdu pěkné.
To si někdo vyhrál. I love Excel too...
Todle je fakt dost dobrý odkaz.Děkuji.
Střelec 5
- Střelec 5
- Level 1.5
- Příspěvky: 122
- Registrován: srpen 07
- Bydliště: Východní Čechy
- Pohlaví:
- Stav:
Offline
[quote="X"]martinb:
autor: Jiří Číhař
1) pojmenujte buňku, ve které se má zapisovat čas, názvem - "hodiny"
2) zapiště do modulu listu kód pro spuštění časovače při aktivaci listu:
Private Sub Worksheet_Activate()
Call StartClock
End Sub
Private Sub Worksheet_Deactivate()
Call StopClock
End Sub
3) vložte do modulu kódu program... ( viz VBE)
----------------------------------------------------------------
Todle s přílohou viz. v textu nahoře a dole .....vložte do modulu kódu program... ( viz VBE) ........................je na spuštění hodin?? Nějak mi to nefunguje zapnutí času,budete muset pánové mít se mnou více času.
autor: Jiří Číhař
1) pojmenujte buňku, ve které se má zapisovat čas, názvem - "hodiny"
2) zapiště do modulu listu kód pro spuštění časovače při aktivaci listu:
Private Sub Worksheet_Activate()
Call StartClock
End Sub
Private Sub Worksheet_Deactivate()
Call StopClock
End Sub
3) vložte do modulu kódu program... ( viz VBE)
----------------------------------------------------------------
Todle s přílohou viz. v textu nahoře a dole .....vložte do modulu kódu program... ( viz VBE) ........................je na spuštění hodin?? Nějak mi to nefunguje zapnutí času,budete muset pánové mít se mnou více času.
Střelec 5
A co třeba takhle: (V buňce A1 je "=nyní()" formát je "h:mm:ss" v buňce B1 je počet sekund po které mají hodiny běžet. Makro sice běží po celou dobu ale s excelem se dá normálně pracovat.
Kód: Vybrat vše
Sub hodiny()
Dim finish As Variant
finish = Int(Timer)
finish = finish + Range("B1").Value
Do While finish > Timer
DoEvents
Range("A1").Calculate
Loop
End Sub
- Střelec 5
- Level 1.5
- Příspěvky: 122
- Registrován: srpen 07
- Bydliště: Východní Čechy
- Pohlaví:
- Stav:
Offline
X píše:Střelec 5: Bohužel, nemohu dostat soubor .xls do přílohy ani po přejmenování, takže příklad nebude ...
Tak mi to prosím tě pošli jako přílohu.
Naposledy upravil(a) Střelec 5 dne 01 kvě 2012 06:41, celkem upraveno 1 x.
Střelec 5
-
- Mohlo by vás zajímat
- Odpovědi
- Zobrazení
- Poslední příspěvek
-
- 18
- 3576
-
od luko02420
Zobrazit poslední příspěvek
16 kvě 2023 11:27
-
- 0
- 811
-
od Jsimi
Zobrazit poslední příspěvek
06 úno 2024 22:43
-
- 2
- 1316
-
od X
Zobrazit poslední příspěvek
02 čer 2023 18:06
-
- 4
- 90
-
od atari
Zobrazit poslední příspěvek
dnes, 13:28
-
- 1
- 1812
-
od atari
Zobrazit poslední příspěvek
28 dub 2023 12:08
Kdo je online
Uživatelé prohlížející si toto fórum: elninoslov a 7 hostů