[Mek]

Всем привет.
Господа программисты, помогите пожалуйста.

Дано: Программа Эксель 2003. Некоторый файл. Расположен на сетевом ресурсе. Доступен разным пользователям.

Проблема: Человеческий фактор. Забывание закрывать файл сразу после завершения активной работы с ним. Во время работы одного из пользователей файл становится недоступным для других (доступно только чтение).

Требуется: Прикрутить к файлу Нечто. Чтобы выскакивало окошко и спрашивало: "Уважаемый пользователь! Вы уже трудитесь над этим файлом N минут. Продолжить? Закрыть?". Допустим чтобы каждые 30 минут такое окошко выскакивало. При выборе "Закрыть" при наличии изменений - стандартный запрос на сохранение. При отсутствии изменений - сразу закрывать.

Реально ли прикрутить это именно к файлу. Чтобы при открытии из любого места с любого компьютера появлялся такой запрос?

п.с. Языками программирования не владею..

[Кулик Алексей aka kpblc]

По-моему, будет проще сделать совместный доступ на файл.

[Mek]

Сообщение от Кулик Алексей aka kpblc По-моему, будет проще сделать совместный доступ на файл.

От этого пришлось отказаться. В Общий файл нельзя вставлять гиперссылки.. и еще много чего там нельзя..

[KronSerg]

Вставь такой макрос:

Public Sub Auto_open() Dim a As Byte y = ActiveWorkbook.Name 1: DoEvents i = Time j = Time k = j - i While k < 2.08333333333333E-02 DoEvents k = j - i j = Time Wend a = MsgBox("Документ открыт уже 30мин, хотите закрыть его?", vbYesNo) If a = 7 Then GoTo 1 ' Новый отсчёт If a = 6 Then Workbooks(y).Close ' Закрывает книгу End Sub

Бывалые програмеры, простите уж самоучку за такой код.

[Mek]

Сообщение от KronSerg Вставь такой макрос...

Спасибо, попробую...

Минус в том что пользователь может выбирать включать ли макросы или нет..

[KronSerg]

Создайте сертификат и подпишите макрос, окошко исчезнет.
Вот, немного доработал:

Код:

[Выделить все]

Public Sub Auto_open()
Dim a, r As Byte
Dim s, y As String
y = ActiveWorkbook.Name
r = 0
1: DoEvents
i = Time
j = Time
k = j - i
While k < 2.08333333333333E-02
DoEvents
k = j - i
j = Time
Wend
r = r + 1
s = "Документ " & y & " открыт уже " & Format(30 * r) & " мин, хотите закрыть его?"
a = MsgBox(s, vbYesNo)
If a = 7 Then GoTo 1 ' Новый отсчёт
If a = 6 Then Workbooks(y).Close ' Закрывает книгу
End Sub

[Mek]

Сообщение от KronSerg Создайте сертификат и подпишите макрос, окошко исчезнет.

Ок. Потестируем...

Сертификат создал, макрос подписал. На моем компьютере перестало блокировать макрос. Это плюс..
Открыл файл, через полчаса замигало окошко. Это плюс.
На запрос ответил "Нет". Файл остался открытым. Это плюс.
При ответе "Да" появился стандартный запрос на сохранение изменений. Ответил да, файл закрылся. Это плюс.

Минусы:
1. Невозможность открытия других файлов эксель. Тупо не открываются. (критично)
2. Перестали работать гиперссылки на документы (pdf), хотя гиперссылки выглядят как надо. Гиперссылка на переход к другому листу в этом же файле работает. (критично)
3. Если открыты другие документы эксель и еще открыть файл с макросом, то переход от одного файла к другому возможен только через меню Окно. Переключение по "Alt +Tab" не работает. Щелчки по свернутым внизу экрана ярлычкам не работают. (критично)
4. Не отображаются примечания. Отображаются только их красные треугольнички. (критично)
5. Не появляется окошко, предупреждающее о включенной защите защищенных ячеек при попытке их редактирования. Защищенные ячейки тупо не редактируются, ничего не происходит. (не критично)
6. Не работает поиcк внутри файла. Окошко поиска открывается (Ctrl+F) но ничего не ищет. (критично)

[Mikha]

>>KronSerg

Код:

[Выделить все]

While k < 2.08333333333333E-02
DoEvents
k = j - i
j = Time
Wend

Данный цикл загружает процессор на 100%
Выражение DoEvents в данном случае не спасет
Возможное решение проблемы Scheduling Events With OnTime And Windows Timers

[KronSerg]

Mikha, спасибо, вот так должно заработать:

Код:

[Выделить все]

Public y As String
Public r As Byte
Public Const cRunIntervalSeconds = 1800 'Время в секундах
Public Sub Auto_open()
y = ActiveWorkbook.Name
Call qwer
End Sub

Sub qwer()
Dim RunWhen As Double
Const cRunWhat = "qwerty"
    RunWhen = Now + TimeSerial(0, 0, cRunIntervalSeconds)
    Application.OnTime EarliestTime:=RunWhen, Procedure:=cRunWhat, _
        Schedule:=True

End Sub
Sub qwerty()
Dim a As Byte
Dim s As String
a = 7
r = r + 1
s = "Документ " & y & " открыт уже " & Format(cRunIntervalSeconds * r/60) & " мин, хотите закрыть его?"
a = MsgBox(s, vbYesNo)
If a = 7 Then Call qwer
If a = 6 Then Workbooks(y).Close
End Sub

[Mek]

Последний раз редактировалось Кулик Алексей aka kpblc, Сегодня в 02:39. Причина: Исправил косяк

О каком косяке речь? Вчера вечером создал макрос с этим кодом. ("Косяк" был исправлен позже) Вроде заработало все как надо..

[Кулик Алексей aka kpblc]

Mek, я тэги менял с quote на code.

[KronSerg]

На всякий случай сравни коды, я тоже правил, косяк был в том, что закрывался в данный момент открытый файл а не носитель макроса.

[Mek]

Сообщение от KronSerg На всякий случай сравни коды, я тоже правил, косяк был в том, что закрывался в данный момент открытый файл а не носитель макроса.

Макрос у меня в редакторе выглядит иначе, чем выглядит код в сообщении №9. Картинку прилагаю. Отличия начинаются с пятой строки..
Вроде работает.. Потестю еще..

[KronSerg]

Поменяй макрос, если работать в другой книге и ответить "Нет" выскочившему окошку, в следующий раз этот макрос предложит закрыть книгу в которой был дан ответ, а не ту из которой работает.

[Mek]

Сообщение от KronSerg Поменяй макрос, если работать в другой книге и ответить "Нет" выскочившему окошку, в следующий раз этот макрос предложит закрыть книгу в которой был дан ответ, а не ту из которой работает.

Поменял. Всё работает. Фантастика!

Готов перечислить скромную сумму на счет мобильного телефона автору макроса. Номер мобилы, город и оператора сообщите в пагер...

[Дерия]

Подскажите пожалуйста. Стала использовать этот код. Вылетает ошибка "Не удается выполнить макрос С:......\Книга1.xls'!qwerty. Возможно этот макрос отсутствует в текущей книги либо все макросы отключены."
Получается он не видит третью процедуру. Не подскажите в чем проблема может быть?

[KronSerg]

Макрос подписала, настройки безопасности макросов проверила?

[Дерия]

Да. Я даже попробовала просто включить все макросы. Все равно не видит. Причем первую же процу запускает, вторую через OnTime нет.

[KronSerg]

вторую через OnTime нет

В смысле ждёт 1800 сек и выдаёт ошибку?

[Дерия]

Аха. Только я уменьшила до 10 секунд