[Mek]

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

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

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

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

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

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

[KronSerg]

попробуй поменять qwerty (в двух местах) на другое имя, через надстройку загрузить, на другом компе попробуй, в общем, не знаю я.

[Дерия]

Все отлично заработало. Пересоздала заного модуль и стало все нормально. Не знаю чего там было если честно.

Другая проблема.
Я создала цифровую подпись и сертификат но человек по сети открывает файл и унего макросы отключены. Получается я создала сертификат для личного пользования только на этом компе. Не подскажите как сделать чтобы и другие пользователи смогли работать с этим макросом. Я просто ниразу не настраивала сертьификаты

[KronSerg]

Дерия, если хотите ответ пишите новое сообщение, о редактировании старого уведомление не приходит. Перенастройте безопасность макросов на компе в сети и примите с него сертификат. Да, я что зашёл-то, пока суть да дело ещё недочёт исправил:

Код:

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

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

Sub qwer()
 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, "0.0") & " мин, хотите закрыть его?"
a = MsgBox(s, vbYesNo)
If a = 7 Then Call qwer
If a = 6 Then Workbooks(y).Close
End Sub
Sub Auto_Close()
On Error GoTo 0
Application.OnTime EarliestTime:=RunWhen, Procedure:=cRunWhat, _
        Schedule:=False
End Sub

[Mek]

Да, я что зашёл-то, пока суть да дело ещё недочёт исправил:

Дайте-ка угадаю. Недочет был в том что при свернутом Экселе не было видно как выскакивает окошко? Как раз хотел об этом сказать..

п.с Привет с банкомата получен?

[KronSerg]

При свёрнутом Excel, его вкладка начинает мигать жёлтым, разворачивать окно при появлении сообщения или нет решает Виндовс. Косяк был хитрый, если не закрывая сам Excel, закрыть файлик, а потом его ещё раз открыть, сообщения выскакивали и по таймеру первого открытия и по таймеру второго.

п.с Привет с банкомата получен?

Ах вот что это было не понял сразу.
PS Попробую поискать решение для нового косяка.

[Mek]

Сообщение от KronSerg PS Попробую поискать решение для нового косяка.

Сейчас окошко выскакивает даже если эксель свернут. Это в том, предыдущем, не выскакивало.. Так что с этим все нормально..
При установке времени на 10 секунд чего-то бухтит.. какое то предупреждение. ошибка 1004.. но вроде все равно работает.
Если ставить 60 секунд то ошибки вроде нету...

[KronSerg]

Всё, поторопился с первым постом, готовый код с устранённым 1004 и разворачивающий окно:

Код:

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

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

Sub qwer()
 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, "0.0") & " мин, хотите закрыть его?"
Application.WindowState = xlMaximized
a = MsgBox(s, vbYesNo)
If a = 7 Then Call qwer
If a = 6 Then Workbooks(y).Close
End Sub
Sub Auto_Close()
On Error Resume Next
Application.OnTime EarliestTime:=RunWhen, Procedure:=cRunWhat, _
        Schedule:=False
End Sub