Visual Basic, .NET, ASP, VBScript
Новости | Примеры | Библиотека кодов | НеЧаВо | VBA | Справочник по VB | Справочник по WinAPI | ActiveX контролы | Статьи по VB | Мастерская разработчика | Форум VBNet | Яndex bar! | Голосование | Полезные программы | Магазин VBNet | Рассылка | Конкурсы | Юмор | Чат | Реклама на VBNet | Автора! | Ссылки | Бета-тестирование | Послать пример на сайт
 

   
   
     

Форум - VBA

Страница: 1 | 2 |

 

  Вопрос: Выполнение макроса с заданным временным интервалом Добавлено: 24.08.06 14:40  

Автор вопроса:  Juveman
Появился тут следующий вопрос: можно ли сделать так, чтобы макрос выполнялся с заданным временным интервалом?
Если кто-нибудь знает как реализовать такое - напишите плиз или ссылку киньте, где почитать можно.

Либо вместо этого еще годится другое решение, но связанное с другой проблемой: можно ли в ячейку в excel выводить текущее время постоянно? То есть не функцией ТДАТА, а чтобы постоянно обновлялась.

Заранее благодарен за любую помощь!

Ответить

  Ответы Всего ответов: 20  

Номер ответа: 1
Автор ответа:
 Василий



Вопросов: 8
Ответов: 27
  Профиль | | #1 Добавлено: 24.08.06 15:40
Есть решение давай мыло.

Ответить

Номер ответа: 2
Автор ответа:
 Juveman



Вопросов: 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";), "my_Procedure"
This example runs my_Procedure at 5 P.M.

Application.OnTime TimeValue("17:00:00";), "my_Procedure"
This example cancels the OnTime setting from the previous example.

Application.OnTime EarliestTime:=TimeValue("17:00:00";), _
    Procedure:="my_Procedure", Schedule:=False

Ответить

Номер ответа: 4
Автор ответа:
 CyRax



Разработчик Offline Client

ICQ: 204447456 

Вопросов: 180
Ответов: 4229
  Web-сайт: basicproduction.nm.ru
 Профиль | | #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";).Value = Time$
End Sub

Sub TimerProc(ByVal hwnd As Long, ByVal nIDEvent As Long, ByVal uElapse As Long, ByVal lpTimerFunc As Long)
   Mac1
End Sub

Ответить

Номер ответа: 5
Автор ответа:
 Juveman



Вопросов: 1
Ответов: 9
  Профиль | | #5 Добавлено: 24.08.06 16:50
Век живи, век учись :))
Огромное спасибо всем откликнувшимся!
Сделал как написал CyRax. Всё отлично работает. Спасибо!

Ответить

Номер ответа: 6
Автор ответа:
 Juveman



Вопросов: 1
Ответов: 9
  Профиль | | #6 Добавлено: 25.08.06 11:27
не все так просто оказалось к сожалению :(
так, как предложил CyRax, всё работает но только когда открыто именно окно экселя с этим файлом. Если же эксель свернуть или открыть другой файл эксель просто вылетает. Сижу думаю.

Ответить

Номер ответа: 7
Автор ответа:
 Juveman



Вопросов: 1
Ответов: 9
  Профиль | | #7 Добавлено: 25.08.06 11:34
Вроде легко исправилось всего лишь добавлением указателя на конкретную книгу. Посмотрим чего дальше будет.

Ответить

Номер ответа: 8
Автор ответа:
 Juveman



Вопросов: 1
Ответов: 9
  Профиль | | #8 Добавлено: 25.08.06 15:58
все-таки есть проблема.
Всё работает, только вот через некоторое время работы эксель просто закрывается без видимых причин и ошибок. Причем может 5 минут проработать, может 20, а может 40. Но все равно в результате закрывается. Причем не только этот файл, а все открытые файлы в экселе.
Кто-нибудь знает, с чем это может быть связано?

Ответить

Номер ответа: 9
Автор ответа:
 Василий



Вопросов: 8
Ответов: 27
  Профиль | | #9 Добавлено: 25.08.06 16:06
Открой Диспетчер Задач Windows и посмотри сколько Excel жрет памяти!!!
У Excel есть такой глюк он начинает занимать всю память а когда не хватает выдает сообщение "Не хватает виртуальной памяти" - и Закрывается, может закрыться и без предупреждения.
Проверь.

Ответить

Номер ответа: 10
Автор ответа:
 Juveman



Вопросов: 1
Ответов: 9
  Профиль | | #10 Добавлено: 25.08.06 16:30
Провел эксперимент еще раз с включенным диспетчером задач. В результате эксель отрубился минут через 15. Именно эксель грузил проц все время от 0 до 3%. Всего загрузка процессора 5-15%.
Именно в момент закрытия экселя проследить не успел, но судя по диаграмме в диспетчере никаких всплесков особых не было.
объем занимаемой памяти тоже вроде особо не колеблется. Не пойму, в чем дело :(

Ответить

Номер ответа: 11
Автор ответа:
 CyRax



Разработчик Offline Client

ICQ: 204447456 

Вопросов: 180
Ответов: 4229
  Web-сайт: basicproduction.nm.ru
 Профиль | | #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";).Value = Time$
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
Автор ответа:
 Juveman



Вопросов: 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
Автор ответа:
 CyRax



Разработчик Offline Client

ICQ: 204447456 

Вопросов: 180
Ответов: 4229
  Web-сайт: basicproduction.nm.ru
 Профиль | | #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";).Value = Time$
   ActiveSheet.Range("A2";).Value = TimerID
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
Автор ответа:
 Juveman



Вопросов: 1
Ответов: 9
  Профиль | | #15 Добавлено: 28.08.06 14:05
Пробую вариант Василия. Вроде работает. Сейчас тестирую..

Ответить

Страница: 1 | 2 |

Поиск по форуму



© Copyright 2002-2011 VBNet.RU | Пишите нам