Вопрос: Выполнение макроса с заданным временным интервалом | Добавлено: 24.08.06 14:40 |
Автор вопроса: ![]() |
Появился тут следующий вопрос: можно ли сделать так, чтобы макрос выполнялся с заданным временным интервалом?
Если кто-нибудь знает как реализовать такое - напишите плиз или ссылку киньте, где почитать можно. Либо вместо этого еще годится другое решение, но связанное с другой проблемой: можно ли в ячейку в excel выводить текущее время постоянно? То есть не функцией ТДАТА, а чтобы постоянно обновлялась. Заранее благодарен за любую помощь! |
Ответы | Всего ответов: 20 |
Номер ответа: 1 Автор ответа: ![]() ![]() ![]() ![]() Вопросов: 8 Ответов: 27 |
Профиль | Цитата | #1 | Добавлено: 24.08.06 15:40 |
Есть решение давай мыло. |
Номер ответа: 2 Автор ответа: ![]() ![]() ![]() ![]() ![]() ![]() ![]() ![]() ![]() ![]() Вопросов: 1 Ответов: 9 |
Профиль | Цитата | #2 | Добавлено: 24.08.06 15:43 |
juveman.mail@gmail.com
Спасибо за быстрый отклик! ![]() |
Номер ответа: 3 Автор ответа: ![]() ![]() ![]() Вопросов: 7 Ответов: 188 |
Профиль | Цитата | #3 | Добавлено: 24.08.06 15:46 |
В VBA для этого существует событие OnTime объекта Applications. Пример из хелпа VBA: OnTime Method Example
This example runs my_Procedure 15 seconds from now. Application.OnTime Now + TimeValue("00:00:15" ![]() This example runs my_Procedure at 5 P.M. Application.OnTime TimeValue("17:00:00" ![]() This example cancels the OnTime setting from the previous example. Application.OnTime EarliestTime:=TimeValue("17:00:00" ![]() Procedure:="my_Procedure", Schedule:=False |
Номер ответа: 4 Автор ответа: ![]() ![]() ![]() ![]() ![]() ![]() Разработчик Offline Client ICQ: 204447456 Вопросов: 180 Ответов: 4229 |
Web-сайт: Профиль | Цитата | #4 | Добавлено: 24.08.06 16:24 |
Попробуй в каком нибудь событии поставить таймер и по нему запускать макрос.
Книга Private Declare Function KillTimer Lib "user32.dll" ( _
ByVal hwnd As Long, _ ByVal nIDEvent As Long) As Long Private Declare Function SetTimer Lib "user32.dll" ( _ ByVal hwnd As Long, _ ByVal nIDEvent As Long, _ ByVal uElapse As Long, _ ByVal lpTimerFunc As Long) As Long Private Const Timer1 As Long = 1 Private Sub Workbook_NewSheet(ByVal Sh As Object) SetTimer Application.hwnd, Timer1, 3000, AddressOf TimerProc End Sub Private Sub Workbook_BeforeClose(Cancel As Boolean) MsgBox KillTimer(Application.hwnd, Timer1), , "KillTimer" End Sub Модуль Sub Mac1()
ActiveSheet.Range("A1" ![]() End Sub Sub TimerProc(ByVal hwnd As Long, ByVal nIDEvent As Long, ByVal uElapse As Long, ByVal lpTimerFunc As Long) Mac1 End Sub |
Номер ответа: 5 Автор ответа: ![]() ![]() ![]() ![]() ![]() ![]() ![]() ![]() ![]() ![]() Вопросов: 1 Ответов: 9 |
Профиль | Цитата | #5 | Добавлено: 24.08.06 16:50 |
Век живи, век учись ![]() Огромное спасибо всем откликнувшимся! Сделал как написал CyRax. Всё отлично работает. Спасибо! |
Номер ответа: 6 Автор ответа: ![]() ![]() ![]() ![]() ![]() ![]() ![]() ![]() ![]() ![]() Вопросов: 1 Ответов: 9 |
Профиль | Цитата | #6 | Добавлено: 25.08.06 11:27 |
не все так просто оказалось к сожалению ![]() так, как предложил CyRax, всё работает но только когда открыто именно окно экселя с этим файлом. Если же эксель свернуть или открыть другой файл эксель просто вылетает. Сижу думаю. |
Номер ответа: 7 Автор ответа: ![]() ![]() ![]() ![]() ![]() ![]() ![]() ![]() ![]() ![]() Вопросов: 1 Ответов: 9 |
Профиль | Цитата | #7 | Добавлено: 25.08.06 11:34 |
Вроде легко исправилось всего лишь добавлением указателя на конкретную книгу. Посмотрим чего дальше будет. |
Номер ответа: 8 Автор ответа: ![]() ![]() ![]() ![]() ![]() ![]() ![]() ![]() ![]() ![]() Вопросов: 1 Ответов: 9 |
Профиль | Цитата | #8 | Добавлено: 25.08.06 15:58 |
все-таки есть проблема.
Всё работает, только вот через некоторое время работы эксель просто закрывается без видимых причин и ошибок. Причем может 5 минут проработать, может 20, а может 40. Но все равно в результате закрывается. Причем не только этот файл, а все открытые файлы в экселе. Кто-нибудь знает, с чем это может быть связано? |
Номер ответа: 9 Автор ответа: ![]() ![]() ![]() ![]() Вопросов: 8 Ответов: 27 |
Профиль | Цитата | #9 | Добавлено: 25.08.06 16:06 |
Открой Диспетчер Задач Windows и посмотри сколько Excel жрет памяти!!!
У Excel есть такой глюк он начинает занимать всю память а когда не хватает выдает сообщение "Не хватает виртуальной памяти" - и Закрывается, может закрыться и без предупреждения. Проверь. |
Номер ответа: 10 Автор ответа: ![]() ![]() ![]() ![]() ![]() ![]() ![]() ![]() ![]() ![]() Вопросов: 1 Ответов: 9 |
Профиль | Цитата | #10 | Добавлено: 25.08.06 16:30 |
Провел эксперимент еще раз с включенным диспетчером задач. В результате эксель отрубился минут через 15. Именно эксель грузил проц все время от 0 до 3%. Всего загрузка процессора 5-15%.
Именно в момент закрытия экселя проследить не успел, но судя по диаграмме в диспетчере никаких всплесков особых не было. объем занимаемой памяти тоже вроде особо не колеблется. Не пойму, в чем дело ![]() |
Номер ответа: 11 Автор ответа: ![]() ![]() ![]() ![]() ![]() ![]() Разработчик Offline Client ICQ: 204447456 Вопросов: 180 Ответов: 4229 |
Web-сайт: Профиль | Цитата | #11 | Добавлено: 26.08.06 15:03 |
Угу, капризничает. Может при открытии файла ставить таймер?
Это исправленный код, позволяющий добавлять больше одного таймера. Книга Private Declare Function KillTimer Lib "user32.dll" ( _
ByVal hwnd As Long, _ ByVal nIDEvent As Long) As Long Private Declare Function SetTimer Lib "user32.dll" ( _ ByVal hwnd As Long, _ ByVal nIDEvent As Long, _ ByVal uElapse As Long, _ ByVal lpTimerFunc As Long) As Long Private Sub Workbook_BeforeClose(Cancel As Boolean) Dim Counter As Integer For Counter = TimerN To 1 Step -1 MsgBox KillTimer(Application.hwnd, Counter), , "Timer: " & Counter Next Counter End Sub Private Sub Workbook_Open() TimerN = TimerN + 1 SetTimer Application.hwnd, TimerN, 100, AddressOf TimerProc End Sub Модуль Public TimerN As Long
Sub Mac1() ActiveSheet.Range("A1" ![]() End Sub Sub TimerProc(ByVal hwnd As Long, ByVal nIDEvent As Long, ByVal uElapse As Long, ByVal lpTimerFunc As Long) 'uElapse - идентификатор(номер) таймера Mac End Sub Именно эксель грузил проц все время от 0 до 3%.
Интервал какой ставил? Чем короче интервал, тем больше загрузка. Вообще 1 секунда - 1000. PS: Excel всё равно выбивает. Видимо прийдётся отказаться от API-таймера, хотя в Word'е вроде работало без сбоев. |
Номер ответа: 12 Автор ответа: ![]() ![]() ![]() ![]() ![]() ![]() ![]() ![]() ![]() ![]() Вопросов: 1 Ответов: 9 |
Профиль | Цитата | #12 | Добавлено: 26.08.06 17:55 |
Ставил значение 3000 и 5000. Особой разницы при этом в загрузке проца не заметил. То что 1000 = 1 секунде я понял. Но от этого не легче.
Жалко, если придется от этого отказаться, вариант красивый и простой был. Василий, а у тебя нету пароля от исходников того, что ты мне прислал? а то в том виде как оно есть, оно для меня почти бесполезно. Хотя бы посмотреть как там таймер сделан. |
Номер ответа: 13 Автор ответа: ![]() ![]() ![]() ![]() Вопросов: 8 Ответов: 27 |
Профиль | Цитата | #13 | Добавлено: 26.08.06 23:48 |
Размещение в ячейке электронных часов
Sub UpdateTime()
Dim varNextCall As Variant ' Записываем в ячейку текущее время Cells(1, 1).Value = Now ' Записываем в varNextCall время, когда вызвать этот макрос _ в следующий раз (через 1 секунду) varNextCall = TimeSerial(Hour(Now), Minute(Now), Second(Now) + 1) ' Уведомляем Excel в необходимости вызова макроса Application.OnTime varNextCall, "UpdateTime" End Sub У меня работает. |
Номер ответа: 14 Автор ответа: ![]() ![]() ![]() ![]() ![]() ![]() Разработчик Offline Client ICQ: 204447456 Вопросов: 180 Ответов: 4229 |
Web-сайт: Профиль | Цитата | #14 | Добавлено: 27.08.06 02:06 |
Возможно выбивает из за того что таймер устанавливается на Application.hWnd.
Здесь код чуть сложнее. При открытии книги вызывается функция ShowChilds, которая перебирает дочерние окна Application.hWnd и ищет окно класса EXCEL7 (что соответствует книге) и класса XLDESK (что соответствует родительскому MDI окну книги). Последний нужен для определения hWnd активной книги, чтобы знать какой таймер удалять. Пример не полнофункционален, это лишь демонстрация. Рутину делай сам. Алгоритм приспособлен для работы только с одной книгой (с одним окном книги). Чтобы реагировать на каждую книгу можно создать массив hWnd и заполнить его идентификаторами (hWnd) всех окон класса EXCEL7, которые встретятся в процедуре перечисления дочерних окон EnumChildProc. Каждому hWnd окна класса EXCEL7 должен быть сопоставлен идентификатор таймера. В принципе, если такие сложности не нужны, просто сделай корректное создание удаление одного таймера при открытии/закрытии книги. Вобщем, если есть вопросы - задавай. Книга Private Sub Workbook_BeforeClose(Cancel As Boolean)
RemoveAllTimers End Sub Private Sub Workbook_Open() 'AddTimer 1000 'интервал 1 секунда ShowChilds End Sub Модуль Public TimerN As Long
Public Declare Function KillTimer Lib "user32.dll" ( _ ByVal hwnd As Long, _ ByVal nIDEvent As Long) As Long Public Declare Function SetTimer Lib "user32.dll" ( _ ByVal hwnd As Long, _ ByVal nIDEvent As Long, _ ByVal uElapse As Long, _ ByVal lpTimerFunc As Long) As Long Declare Function EnumChildWindows Lib "user32" (ByVal hWndParent As Long, ByVal lpEnumFunc As Long, ByVal lParam As Long) As Long Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal hwnd As Long, ByVal lpString As String, ByVal cch As Long) As Long Declare Function GetWindowTextLength Lib "user32" Alias "GetWindowTextLengthA" (ByVal hwnd As Long) As Long Private Declare Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hwnd As Long, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long Private ChildN As Byte Public hWndBook As Long Private Const ClassBook As String = "EXCEL7" Private Const MDIBook As String = "XLDESK" Public hWndMDI As Long Private Declare Function GetTopWindow Lib "user32.dll" ( _ ByVal hwnd As Long) As Long Private Declare Function SendMessage Lib "user32.dll" Alias "SendMessageA" ( _ ByVal hwnd As Long, _ ByVal wMsg As Long, _ ByVal wParam As Long, _ ByRef lParam As Any) As Long Private Const WM_MDIGETACTIVE As Long = &H229 Sub Mac1(ByVal TimerID As Long) ActiveSheet.Range("A1" ![]() ActiveSheet.Range("A2" ![]() End Sub Sub TimerProc(ByVal hwnd As Long, ByVal nIDEvent As Long, ByVal uElapse As Long, ByVal lpTimerFunc As Long) Mac1 uElapse End Sub Sub AddTimer(ByVal hwnd As Long, ByVal mSec As Long) TimerN = TimerN + 1 SetTimer hwnd, TimerN, mSec, AddressOf TimerProc End Sub Sub RemoveAllTimers() If hWndBook = 0 Then Exit Sub Else Dim hWndCh As Long hWndCh = SendMessage(hWndMDI, WM_MDIGETACTIVE, 0, 0) If hWndCh <> hWndBook Then Exit Sub End If Dim Counter As Integer For Counter = TimerN To 1 Step -1 MsgBox KillTimer(hWndBook, Counter), , "Timer: " & Counter Next Counter End Sub Sub ShowChilds() ChildN = 2 EnumChildWindows Application.hwnd, AddressOf EnumChildProc, ByVal 0& End Sub Public Function EnumChildProc(ByVal hwnd As Long, ByVal lParam As Long) As Long Dim sSave As String sSave = Space$(GetWindowTextLength(hwnd) + 1) GetWindowText hwnd, sSave, Len(sSave) sSave = Left$(sSave, Len(sSave) - 1) Dim lpClassName As String, RetVal As Long lpClassName = Space(256) RetVal = GetClassName(hwnd, lpClassName, 256) lpClassName = Left$(lpClassName, RetVal) If lpClassName = ClassBook Then hWndBook = hwnd AddTimer hWndBook, 1000 ElseIf lpClassName = MDIBook Then hWndMDI = hwnd End If If sSave <> "" Then 'Dim RowNum As String 'RowNum = "A" & LTrim$(ChildN) 'ActiveSheet.Range(RowNum).Value = sSave 'RowNum = "F" & LTrim$(ChildN) 'ActiveSheet.Range(RowNum).Value = lpClassName 'ChildN = ChildN + 1 End If EnumChildProc = 1 End Function PS: Тестировал в течение 25 минут - сбоев не было. Так что проблема скорее всего была действительно в конфликте таймера и Application.hWnd. PPS: Видимо после ответа (13) публиковать это уже бессмысленно, но не пропадать же труду. ![]() |
Номер ответа: 15 Автор ответа: ![]() ![]() ![]() ![]() ![]() ![]() ![]() ![]() ![]() ![]() Вопросов: 1 Ответов: 9 |
Профиль | Цитата | #15 | Добавлено: 28.08.06 14:05 |
Пробую вариант Василия. Вроде работает. Сейчас тестирую.. |
|