Zdravím,
pokouším se napsat makro, které se po několika minutách od otevření souboru zeptá a případně uloží změny a ukončí excel
zatím mi s pomocí tohoto fóra vyšlo toto:
Sub Ukonci10min()
Application.OnTime Now + TimeValue("00:10:00"), "Konec"
End Sub
Sub Konec()
If MsgBox("Opravdu ještě potřebujete pracovat v tomto souboru?", vbYesNo, "") <> vbNo Then Exit Sub
ChDir "C:\test"
ActiveWorkbook.SaveAs Filename:= _
"C:\test\test.xls", FileFormat:= _
xlExcel8, Password:="", WriteResPassword:="", ReadOnlyRecommended:=False _
, CreateBackup:=False
Dim strClsExl As String
strClsExl = "TASKKILL /F /IM Excel.exe"
Shell strClsExl, vbHide
End Sub
Ale mám tam chybu, ať vyberu yes nebo no, vždy se mi uloží a zavře ..
prosím o radu
Excel - makro na ukončení aplikace Vyřešeno
-
- Level 3
- Příspěvky: 452
- Registrován: leden 12
- Bydliště: Země, bohužel...
- Pohlaví:
- Stav:
Offline
- Kontakt:
Re: Excel - makro na ukončení aplikace
Na to bych použila Select case
Kód: Vybrat vše
dotaz = MsgBox("Opravdu ještě potřebujete pracovat v tomto souboru?", vbYesNo, "")
Select Case dotaz
Case vbYes
Exit Sub
Case vbNo
End Select
Pokud je to vše.
Vše co znám z VBA jsem se naučila tady na fóru, na Office.lasakovi, david-zbiral.cz a hlavně hledáním na googlu.
SZ není poradna, na pokládání dotazů je tu fórum. Děkuji.
Vše co znám z VBA jsem se naučila tady na fóru, na Office.lasakovi, david-zbiral.cz a hlavně hledáním na googlu.
SZ není poradna, na pokládání dotazů je tu fórum. Děkuji.
Re: Excel - makro na ukončení aplikace
díky, upravil jsem to následujícím způsobem:
Private Sub Workbook_Open()
Application.OnTime Now + TimeValue("00:00:30"), "Konec"
End Sub
Sub Konec()
dotaz = MsgBox("Opravdu ještě potřebujete pracovat v tomto souboru?", vbYesNo, "")
Select Case dotaz
Case vbYes
Exit Sub
Case vbNo
End Select
ActiveWorkbook.SaveAs Filename:= _
"C:\test\test.xls", FileFormat:= _
xlExcel8, Password:="", WriteResPassword:="", ReadOnlyRecommended:=False _
, CreateBackup:=False
Dim strClsExl As String
strClsExl = "TASKKILL /F /IM Excel.exe"
Shell strClsExl, vbHide
End Sub
Když makro spustím ručně, tak zafunguje.
Ale samo se mi nespustí ...
Po otevření souboru se excel ptá zda obnovit poškozený soubor ...
v čem jsem to zas udělal špatně?
Private Sub Workbook_Open()
Application.OnTime Now + TimeValue("00:00:30"), "Konec"
End Sub
Sub Konec()
dotaz = MsgBox("Opravdu ještě potřebujete pracovat v tomto souboru?", vbYesNo, "")
Select Case dotaz
Case vbYes
Exit Sub
Case vbNo
End Select
ActiveWorkbook.SaveAs Filename:= _
"C:\test\test.xls", FileFormat:= _
xlExcel8, Password:="", WriteResPassword:="", ReadOnlyRecommended:=False _
, CreateBackup:=False
Dim strClsExl As String
strClsExl = "TASKKILL /F /IM Excel.exe"
Shell strClsExl, vbHide
End Sub
Když makro spustím ručně, tak zafunguje.
Ale samo se mi nespustí ...
Po otevření souboru se excel ptá zda obnovit poškozený soubor ...
v čem jsem to zas udělal špatně?
-
- Level 3
- Příspěvky: 452
- Registrován: leden 12
- Bydliště: Země, bohužel...
- Pohlaví:
- Stav:
Offline
- Kontakt:
Re: Excel - makro na ukončení aplikace
Ten soubor se bude ukládat na stejné místo kde se otevírá? Resp. pokud se název a umístění nebude měnit, tak místo ActiveWorkbook.SaveAs a vše co je pod tím bych nahradila následujícím:
Jakou máte verzi Office?
Kód: Vybrat vše
ActiveWorkbook.save
Application.DisplayAlerts = False
Application.Quit
Jakou máte verzi Office?
Pokud je to vše.
Vše co znám z VBA jsem se naučila tady na fóru, na Office.lasakovi, david-zbiral.cz a hlavně hledáním na googlu.
SZ není poradna, na pokládání dotazů je tu fórum. Děkuji.
Vše co znám z VBA jsem se naučila tady na fóru, na Office.lasakovi, david-zbiral.cz a hlavně hledáním na googlu.
SZ není poradna, na pokládání dotazů je tu fórum. Děkuji.
Re: Excel - makro na ukončení aplikace
Soubor se ukládá do stejného místa, office mám 2010 a v angličtině - na to prostě nestačím
-
- Level 3
- Příspěvky: 452
- Registrován: leden 12
- Bydliště: Země, bohužel...
- Pohlaví:
- Stav:
Offline
- Kontakt:
Re: Excel - makro na ukončení aplikace
To makru bude vypadat následovně:
V tom vašem makru ukládáte soubor do staršího formátu a tím to možná dělá tu chybu. Vyzkoušejte co jsem napsala, teď už by to mělo fungovat.
Kód: Vybrat vše
Sub Konec()
Dim dotaz as Integer
dotaz = MsgBox("Opravdu ještě potřebujete pracovat v tomto souboru?", vbYesNo, "")
Select Case dotaz
Case vbYes
Exit Sub
Case vbNo
End Select
'Uloží a ukončí excel
ActiveWorkbook.save
Application.DisplayAlerts = False
Application.Quit
End Sub
V tom vašem makru ukládáte soubor do staršího formátu a tím to možná dělá tu chybu. Vyzkoušejte co jsem napsala, teď už by to mělo fungovat.
Pokud je to vše.
Vše co znám z VBA jsem se naučila tady na fóru, na Office.lasakovi, david-zbiral.cz a hlavně hledáním na googlu.
SZ není poradna, na pokládání dotazů je tu fórum. Děkuji.
Vše co znám z VBA jsem se naučila tady na fóru, na Office.lasakovi, david-zbiral.cz a hlavně hledáním na googlu.
SZ není poradna, na pokládání dotazů je tu fórum. Děkuji.
Re: Excel - makro na ukončení aplikace
Děkuju, opravil jsem to, ale pro změnu dostanu hned hlášku, že nemám povolená makra ...
Soubor je uložen jako Excel Makro-Enabled Workbook.
ostatní makra mi standardně fungují ...
asi se na to už vykašlu
Soubor je uložen jako Excel Makro-Enabled Workbook.
ostatní makra mi standardně fungují ...
asi se na to už vykašlu
Re: Excel - makro na ukončení aplikace
řešení se našlo ... a bylo velmi jednoduché ...
stačilo přesunout proceduru Konec() z ThisWorkbook do Modulu1
Teď se ještě pokouším doladit detaily ...
Krok 1. - dotaz zda je potřeba pracovat v souboru (Ano / Ne)
Krok 2 - Ano - opět čeká 10 minut následuje krok 1
Krok 3 - Ne - dotaz Uložit (ano/Ne)
Krok 4 - Ano - uložit, exit
Krok 5 - Ne - exit
zatím se mi soubor ukládá stále ...
prosím, v čem zas mám chybu ...?
stačilo přesunout proceduru Konec() z ThisWorkbook do Modulu1
Teď se ještě pokouším doladit detaily ...
Krok 1. - dotaz zda je potřeba pracovat v souboru (Ano / Ne)
Krok 2 - Ano - opět čeká 10 minut následuje krok 1
Krok 3 - Ne - dotaz Uložit (ano/Ne)
Krok 4 - Ano - uložit, exit
Krok 5 - Ne - exit
zatím se mi soubor ukládá stále ...
prosím, v čem zas mám chybu ...?
Kód: Vybrat vše
Sub Konec()
'Okno - dotaz
Dim dotaz As Integer
dotaz = MsgBox("Opravdu ještě potřebujete pracovat v tomto souboru?", vbYesNo, "")
Select Case dotaz
Case vbYes
Exit Sub
Case vbNo
EditDate = Now
Application.OnTime Now + TimeValue("00:01:00"), "Konec"
'Okno - dotaz1
Dim dotaz1 As Integer
dotaz1 = MsgBox("Soubor bude ukončen. Chcete soubor uložit?", vbYesNo, "")
Select Case dotaz1
Case vbYes
Exit Sub
Case vbNo
'Ukončí excel
Application.DisplayAlerts = False
Application.Quit
End Select
End Select
'Uloží a ukončí excel
ActiveWorkbook.Save
Application.DisplayAlerts = False
Application.Quit
End Sub
Re: Excel - makro na ukončení aplikace
prosím, máte někdo řešení? já ho stále nenašel
-
- Level 3
- Příspěvky: 452
- Registrován: leden 12
- Bydliště: Země, bohužel...
- Pohlaví:
- Stav:
Offline
- Kontakt:
Re: Excel - makro na ukončení aplikace Vyřešeno
Mrkla jsem na ten kód a máte tam zpřeházených pár řádků. Taky bych tam přidala kontrolu změn v sešitu aby se přesně každých 10minut neukazovala tabulka zda chci ještě pokračovat v práci když stále pracuji.
Ukládá se to proto, že ukládání je úplně na konci makra neošetřeno což proběhne vždy. To jsou ty zpřeházené řádky.
Nastavte si proměnnou cas podle toho za jak dlouho se má dotaz ukázat, pro ladění tam je 10sec. Po každé změně v sešitu se resetuje Timer a pak se zobrazení dotazu oddálí o daný časový úsek.
Makra budou vypadat následovně:
Module:
Předpokládám, že s proměnnou EditDate se bude dál pracovat, tak jsem ji tam nechala
Kontrola používání sešitu v ThisWorkbook
Ukládá se to proto, že ukládání je úplně na konci makra neošetřeno což proběhne vždy. To jsou ty zpřeházené řádky.
Nastavte si proměnnou cas podle toho za jak dlouho se má dotaz ukázat, pro ladění tam je 10sec. Po každé změně v sešitu se resetuje Timer a pak se zobrazení dotazu oddálí o daný časový úsek.
Makra budou vypadat následovně:
Module:
Kód: Vybrat vše
Option Explicit
Sub ResetTimer()
Dim cas As String, CloseDownTime As Date
'*****************************************************
'Nastavení časové prodlevy formát "00:00:00"
cas = "00:00:10"
'*****************************************************
On Error Resume Next
If Not IsEmpty(CloseDownTime) Then
Application.OnTime CloseDownTime, "Konec", Schedule:=False 'zastaví spuštění makra "Konec"
End If
CloseDownTime = Now + TimeValue(cas)
Application.OnTime CloseDownTime, "Konec" 'Nastaví nový čas spuštění makra "Konec"
End Sub
Sub Konec()
Dim dotaz As Integer, dotaz1 As Integer
Dim EditDate As Date
'Okno - dotaz
dotaz = MsgBox("Opravdu ještě potřebujete pracovat v tomto souboru?", vbYesNo, "")
Select Case dotaz
Case vbYes
ResetTimer
Exit Sub
Case vbNo
EditDate = Now
'Okno - dotaz1
dotaz1 = MsgBox("Soubor bude ukončen." & vbCrLf & "Chcete soubor uložit?", vbYesNo, "")
Select Case dotaz1
Case vbYes
'uloží a ukončí excel
ActiveWorkbook.Save
Application.DisplayAlerts = False
Application.Quit
Exit Sub
Case vbNo
'ukončí excel bez uložení
Application.DisplayAlerts = False
Application.Quit
End Select
End Select
End Sub
Předpokládám, že s proměnnou EditDate se bude dál pracovat, tak jsem ji tam nechala
Kontrola používání sešitu v ThisWorkbook
Kód: Vybrat vše
Option Explicit
Private Sub Workbook_SheetCalculate(ByVal Sh As Object)
ResetTimer
End Sub
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
ResetTimer
End Sub
Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
ResetTimer
End Sub
Pokud je to vše.
Vše co znám z VBA jsem se naučila tady na fóru, na Office.lasakovi, david-zbiral.cz a hlavně hledáním na googlu.
SZ není poradna, na pokládání dotazů je tu fórum. Děkuji.
Vše co znám z VBA jsem se naučila tady na fóru, na Office.lasakovi, david-zbiral.cz a hlavně hledáním na googlu.
SZ není poradna, na pokládání dotazů je tu fórum. Děkuji.
-
- Mohlo by vás zajímat
- Odpovědi
- Zobrazení
- Poslední příspěvek
-
- 5
- 1972
-
od Roman Tyčka
Zobrazit poslední příspěvek
11 pro 2023 18:40
-
- 9
- 1265
-
od mmmartin
Zobrazit poslední příspěvek
29 srp 2023 16:47
-
- 1
- 1123
-
od petr22
Zobrazit poslední příspěvek
28 led 2024 12:36
-
-
Žlutomodrý štít u ikony aplikace w11 Příloha(y)
od PittnerJiri » 01 srp 2023 15:03 » v Windows 11, 10, 8... - 5
- 2259
-
od petr22
Zobrazit poslední příspěvek
23 zář 2023 19:16
-
-
-
Explorer.exe - chyba aplikace 0x0000000000000024
od Dav98786 » 31 led 2024 20:26 » v Windows 11, 10, 8... - 2
- 945
-
od Dav98786
Zobrazit poslední příspěvek
01 úno 2024 09:17
-
Kdo je online
Uživatelé prohlížející si toto fórum: Žádní registrovaní uživatelé a 9 hostů