Поиск  Пользователи  Правила 
Закрыть
Логин:
Пароль:
Забыли свой пароль?
Регистрация
Войти
 
Страницы: 1 2 След.
RSS
Автоматическое закрытие документа с сохранением.
 
Добрый день
Нужна помощь для создания макроса, который бы закрывал документ с сохранением изменений при неактивности юзера 5-10 минут.
Также, чтоб не давал пользоваться документом, пока не разрешены макросы.
Нашел два таких решения как отдельные в сети, но так и не смог их соединить воедино, чтобы работало.
Спасибо.
 
Цитата
draginoid написал: Нашел два таких решения
Файл-пример с этими решениями покажите
Согласие есть продукт при полном непротивлении сторон.
 
документ в приложении.
а часть для ограничения доступа подходит от сюда:
http://www.planetaexcel.ru/techniques/5/196/
Изменено: draginoid - 4 Окт 2017 08:53:45
 
хотел бы приподнять тему.
 
ловиТЕ
Изменено: Horror - 5 Окт 2017 09:59:13
 
Horror, Доброго времени, подскажите, иногда сохраняет и закрывается а иногда выводит окно где сохранить и прекращена работа Ексель. идет сбой
 
Да, подвисает
И нет требования включить макросы.
 
требование включить макрос можете изменить в настройках EXCEL
Изменено: Horror - 5 Окт 2017 10:25:53
 
Я писал в первом посте: , чтоб не давал пользоваться документом, пока не разрешены макросы.
То есть, скрывал бы все листы, кроме предупреждения о включении макросов.
 
а может кто просто подскажет, как мои найденные варианты соединить вместе?
 
мой прикрепленный документ работает хорошо.
к нему нужно дополнение, чтобы скрывало все листы, кроме листа с предупреждением, пока не разрешены макросы.
 
хотел бы приподнять тему
 
Цитата
draginoid написал:
чтоб не давал пользоваться документом, пока не разрешены макросы
Вот эта  статья должна помочь.
 
не открывается
 
кто бы еще мог помочь?
 
Цитата
Юрий М написал:
 статья  
Ссылка некузявая
 
Исправил.
 
Я это смотрел.
как мне соединить макрос в моем документе с этим из стать?
 
когда я просто дописываю макрос из статьи, получаю ошибку:
Изменено: draginoid - 11 Окт 2017 09:15:19
 
Сия процедура может существовать только в количестве 1шт.
 
так что можно сделать, что бы работали два макроса, или создать новый по условию?
 
Привет!

Запаролить что нужно.
Настроить кнопку распароливания.
Настроить запароливание по Workbook_BeforeClose
Сохранить книгу.
Имеем книгу с запароленными частями.
Отключить макросы.
Открыть книгу, чтобы отбработал макрос распароливания, придётся включить макросы.
Кнопкой распаролю.
Отключу макросы и сохранив, получу книгу с доступным запретным плодом
Так?

Вопрос с сохранением при неактивности более инетересный ...
 
у меня в 3-ем посте прикреплен документ с уже готовым решением для автозакрытия дока прие неактивности.
 
неужто это невозможно решить?
 
draginoid, у Вас событийные процедуры написаны несколько раз (повторяются), а это недопустимо. Событие одно, а вот действий в них может быть несколько.
 
вот поэтому я и прошу помощи у спецов или объединить два макроса или новый создать.
В макросах я профан
 
Я уж и не знаю, как ещё объяснять... На примере Workbook_Open(): у Вас две процедуры с этим названием. Удалите одну из них, а её содержимое скопируйте в оставшуюся. Упрощённый пример:
Код
'Private Sub Workbook_Open()
'    Sheets("Лист1").Activate
'End Sub

'Private Sub Workbook_Open()
'    MsgBox "Готово!"
'End Sub

Private Sub Workbook_Open()
    Sheets("Лист1").Activate
    MsgBox "Готово!"
End Sub
Так понятно?
 

Все предельно понятно.
Спасибо.
Но когда я помещаю содержимое одного в другое, начинает ругаться, а я знаю, как потом все исправить.

Код
Private Sub Workbook_BeforeClose(Cancel As Boolean)
    'èùåì ïîñëåäíþþ çàíÿòóþ ñòðî÷êó â ëîãàõ
    lastrow = Worksheets("Ëîã").Range("A60000").End(xlUp).Row
    'çàíîñèì äàòó-âðåìÿ âûõîäà èç ôàéëà
    If lastrow > 1 Then Worksheets("Ëîã").Cells(lastrow, 3) = Now
     
    'ñêðûâàåì âñå ëèñòû, êðîìå ëèñòà ÏÐÅÄÓÏÐÅÆÄÅÍÈÅ
    Worksheets("Ïðåäóïðåæäåíèå").Visible = True
    For Each Sh In ActiveWorkbook.Worksheets
        If Sh.Name = "Ïðåäóïðåæäåíèå" Then
            Sh.Visible = True
        Else
            Sh.Visible = xlSheetVeryHidden
        End If
    Next Sh
     
    'ñîõðàíÿåìñÿ ïåðåä âûõîäîì
    ActiveWorkbook.Save
End Sub
 
Private Sub Workbook_Open()
    'èùåì ïîñëåäíþþ çàíÿòóþ ñòðî÷êó â ëîãàõ
    lastrow = Worksheets("Ëîã").Range("A60000").End(xlUp).Row
    'çàíîñèì èìÿ ïîëüçîâàòåëÿ è äàòó-âðåìÿ âõîäà â ôàéë
    Worksheets("Ëîã").Cells(lastrow + 1, 1) = Environ("USERNAME")
    Worksheets("Ëîã").Cells(lastrow + 1, 2) = Now
     
    'îòîáðàæàåì âñå ëèñòû
    For Each Sh In ActiveWorkbook.Worksheets
        Sh.Visible = True
    Next Sh
    'ñêðûâàåì ëèñòû ÏÐÅÄÓÏÐÅÆÄÅÍÈÅ è ËÎÃ
    Worksheets("Ïðåäóïðåæäåíèå").Visible = xlSheetVeryHidden
    Worksheets("Ëîã").Visible = xlSheetVeryHidden
     
     DateTime = Now + #12:10:00 AM#
    Application.OnTime DateTime, "TimeOut"
End SubOption ExplicitDim DateTime As DatePrivate Sub Workbook_BeforeClose(Cancel As Boolean)
    On Error Resume Next
    Application.OnTime DateTime, "TimeOut", , False
End SubPrivate Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
    Workbook_BeforeClose False
    Workbook_Open
End Sub



Извините за незнание матчасти

Будьте добры, помогите в решении.

Изменено: draginoid - 12 Окт 2017 23:23:17
 
Гадать? Приехать? Или покажете?
 
и так пробовал
Код
Option Explicit

Dim DateTime As Date

Private Sub Workbook_Open()
  DateTime = Now + #12:20:00 AM#
    Application.OnTime DateTime, "TimeOut"
    

'???? ????????? ??????? ??????? ? ?????
    iLastrow = Worksheets("log").Range("A60000").End(xlUp).Row
    '??????? ??? ???????????? ? ????-????? ????? ? ????
    Worksheets("log").Cells(Lastrow + 1, 1) = Environ("USERNAME")
    Worksheets("log").Cells(Lastrow + 1, 2) = Now
     
    '?????????? ??? ?????
    For Each Sh In ActiveWorkbook.Worksheets
        Sh.Visible = True
    Next Sh
    '???????? ????? ?????????????? ? ???
    Worksheets("warning").Visible = xlSheetVeryHidden
    Worksheets("log").Visible = xlSheetVeryHidden
     
End Sub
  

Private Sub Workbook_BeforeClose(Cancel As Boolean)
 
    On Error Resume Next
    Application.OnTime DateTime, "TimeOut", , False
End Sub
'???? ????????? ??????? ??????? ? ?????
    Lastrow = Worksheets("log").Range("A60000").End(xlUp).Row
    '??????? ????-????? ?????? ?? ?????
    If Lastrow > 1 Then Worksheets("log").Cells(Lastrow, 3) = Now
     
    '???????? ??? ?????, ????? ????? ??????????????
    Worksheets("warning").Visible = True
    For Each Sh In ActiveWorkbook.Worksheets
        If Sh.Name = "warning" Then
            Sh.Visible = True
        Else
            Sh.Visible = xlSheetVeryHidden
        End If
    Next Sh
     
    '??????????? ????? ???????
    ActiveWorkbook.Save
End Sub

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
    Workbook_BeforeClose False
    Workbook_Open
End Sub
Изменено: draginoid - 13 Окт 2017 14:18:51
Страницы: 1 2 След.
Читают тему (гостей: 1)