Поиск  Пользователи  Правила  Войти
Форумы "Планета Excel" » Вопросы по Microsoft Excel
Страницы: 1
RSS
VBA автосохранение каждые н минут + автовыход если ничего не происходит через н минут, В примере файл постоянно открывается заново, прописал stop Ontime, но все равно открывается после закрытия
 
#1
23.06.2017 16:21:50
Добрий день уважаемие гуру екселя!!!!!!
Прошу помощи

Как только прописываю  ActiveWorkbook или ThisWorkbook  .Close файл начинает заново открываться.
Вроде в BeforeClose все прописал

Что нужно добиться:
Если открывать несколько файлов где прописан данный макрос, когда вносишь изменения, файл автоматически сохранєтса каждые 5 мин, если файл изменился.
Єсли нет изменений в файле, то он закрывается через н минут, сохранив при этом изменения, если они есть.
Хочу сократить количество автосохранения переменной “Если файл изменился”
Планирую использовать эти макросы одновременно в нескольких открытых файлах. Ели будут конфликтовать Ontime как можно обойти?
Буду очень благодарен за помощь не владею языком программирования уже всю голову сломал методом тыка)))


Очень важно чтоб работала функция If ThisWorkbook.Saved = False Then, чтоб сохранялся только если есть изменения.

Рабочий пример прикрепляю
Вот где брал идею

http://www.cpearson.com/excel/OnTime.aspx

Изменено: qweewert - 23.06.2017 16:46:46
qweewert
 
 
 
#2
23.06.2017 16:34:37
application.ontime   Вам в помощь!
Программисты - это люди, решающие проблемы, о существовании которых Вы не подозревали, методами, которых Вы не понимаете!
 
 
 
#3
23.06.2017 16:36:42
Спасибо, но не знаю что с этим делать. Можно попросить на примере сделать?
qweewert
 
 
 
#4
23.06.2017 16:38:57
Так у меня в модуле
Код
Option Explicit
Public RunWhen As Double
Public Const cRunIntervalSeconds = 8 ' sec
Public Const cRunWhat = "TheSub"  ' the name of the procedure to run
Public RunWhenq As Double
Public Const cRunIntervalSecondsq = 20 ' sec
Public Const cRunWhatq = "TheSubq"  ' the name of the procedure to run
Sub StartTimer()
    RunWhen = Now + TimeSerial(0, 0, cRunIntervalSeconds)
    Application.OnTime EarliestTime:=RunWhen, Procedure:=cRunWhat, _
        Schedule:=True
End Sub
Sub TheSub()

If ThisWorkbook.Saved = False Then
    ThisWorkbook.Save
    StartTimer
    
    Else
    StartTimer
    End If

End Sub

Sub StopTimer()
    On Error Resume Next
    Application.OnTime EarliestTime:=RunWhen, Procedure:=cRunWhat, _
        Schedule:=False
End Sub
Sub StartTimerq()
    RunWhenq = Now + TimeSerial(0, 0, cRunIntervalSecondsq)
    Application.OnTime EarliestTime:=RunWhenq, Procedure:=cRunWhatq, _
        Schedule:=True
End Sub
Sub TheSubq()
With ActiveWorkbook
    .Save
    .Close
End With
End Sub
Sub StopTimerq()
    On Error Resume Next
    Application.OnTime EarliestTime:=RunWhenq, Procedure:=cRunWhatq, _
        Schedule:=False
End Sub
Изменено: qweewert - 23.06.2017 16:42:24
qweewert
 
 
 
#5
23.06.2017 16:40:29
в   ThisWorkbook
Код
Option Explicit
Private Sub Workbook_Open()
     Application.Calculation = xlManual
    StartTimer
    StartTimerq
End Sub
'Private Sub Worksheet_Change(ByVal Target As Range)
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Application.Calculation = xlManual
ActiveSheet.Calculate
StartTimerq
End Sub
Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, _
  ByVal Target As Excel.Range)
StartTimerq
End Sub
Private Sub Workbook_SheetCalculate(ByVal Sh As Object)
  StartTimerq
End Sub
Private Sub Workbook_Activate()
  StartTimerq
End Sub
Private Sub Workbook_BeforeClose(Cancel As Boolean)
StopTimerq
StopTimer
End Sub
Private Sub Workbook_SheetDeactivate(ByVal Sh As Object)
    ThisWorkbook.Names.Add "prevsh__", Sh.Name
End Sub
Изменено: qweewert - 23.06.2017 16:44:36
qweewert
 
 
 
#6
23.06.2017 22:21:26
Добавил проверку при закрытии и макросы выполняются но все равно книга опять открывается

Код
Sub StopTimerq()
    On Error Resume Next
    Application.OnTime RunWhenq, Procedure:=cRunWhatq, _
        Schedule:=False
Err.Clear: On Error GoTo 0: On Error GoTo -1
    MsgBox "Done"

Sub StopTimer()
    On Error Resume Next
    Application.OnTime RunWhen, Procedure:=cRunWhat, _
        Schedule:=False
Err.Clear: On Error GoTo 0: On Error GoTo -1
    MsgBox "Done"
End Sub

в Workbook
Private Sub Workbook_BeforeClose(Cancel As Boolean)
StopTimerq
StopTimer

End Sub
Изменено: qweewert - 23.06.2017 22:23:04
qweewert
 
 
 
Страницы: 1
Наверх