| Вопрос: Пульсация ячейки цветом в VBA | Добавлено: 11.01.08 15:31 |
Автор вопроса:  Таня | ICQ: 410031407 |
|
Ситуевина!Подскажите - как енто сделать!
Когда ячейка заливается цветом должна начинаться пульсация ячейки цветом, до тех пор пока лист активен. |
| Ответы | Всего ответов: 14 |
|
Номер ответа: 1 Автор ответа:  ADSemenov.ru Вопросов: 5 Ответов: 276 |
Web-сайт: Профиль | | #1 | Добавлено: 11.01.08 15:40 |
|
____ Тут где-то про создание таймера была тема.
____ Может быть можно ещё и цикл в макросе запустить с выходом на обработку других событий через DoEvents, чтобы не подвесить Excel. Только это не даст постоянство периода на разных машинах. |
||
|
Номер ответа: 2 Автор ответа: Таня ICQ: 410031407 Вопросов: 11 Ответов: 23 |
Профиль | | #2 | Добавлено: 11.01.08 15:53 |
| К сожалению ничего нет | ||
|
Номер ответа: 3 Автор ответа: ADSemenov.ruВопросов: 5 Ответов: 276 |
Web-сайт: Профиль | | #3 | Добавлено: 11.01.08 16:13 |
|
____ Есть.
http://vbnet.ru/forum/show.aspx?id=138584 |
||
|
Номер ответа: 4 Автор ответа: ТаняICQ: 410031407 Вопросов: 11 Ответов: 23 |
Профиль | | #4 | Добавлено: 11.01.08 16:23 |
| Спасибки конечно, но меня в первую очередь интересует пульсация цветом | ||
|
Номер ответа: 5 Автор ответа: el-pasoВопросов: 3 Ответов: 164 |
Профиль | | #5 | Добавлено: 11.01.08 16:39 |
|
Private Declare Function GetTickCount Lib "kernel32" () As Long
Private Sub ChangeColor() ' ' здесь реализуется что и как будет мерцать ' With Selection.Interior .Pattern = xlSolid .PatternColorIndex = xlAutomatic .ColorIndex = IIf(.ColorIndex = 3, 0, 3) End With ' End Sub Private Sub Blink(Optional DoStart As Boolean = True) ' ' запуск-остановка мерцания ' интервал мерцания - 1000 мс (изменить, если надо) ' Static Started As Boolean If DoStart And Started Then Exit Sub ' Started = DoStart ' Dim Ticks As Long: Ticks = GetTickCount Dim Sheet As Worksheet: Set Sheet = ActiveSheet ' Selection.Interior.Pattern = xlSolid Selection.Interior.PatternColorIndex = xlAutomatic ' Do While Started If GetTickCount - Ticks >= 1000 Then ChangeColor Ticks = GetTickCount End If DoEvents Loop ' End Sub ' привязка к событиям Private Sub Worksheet_Activate() Blink True End Sub Private Sub Worksheet_Deactivate() Blink False End Sub ' идея понятна? 
' (c) espilacopa@gmail.com |
||
|
Номер ответа: 6 Автор ответа: el-pasoВопросов: 3 Ответов: 164 |
Профиль | | #6 | Добавлено: 11.01.08 16:41 |
|
Selection.Interior.Pattern = xlSolid Selection.Interior.PatternColorIndex = xlAutomatic можна выкинуть найух. сорри. |
||
|
Номер ответа: 7 Автор ответа: ADSemenov.ruВопросов: 5 Ответов: 276 |
Web-сайт: Профиль | | #7 | Добавлено: 11.01.08 16:44 |
| ____ Ну, так пульсация и делается из таймера! В чём проблема-то? | ||
|
Номер ответа: 8 Автор ответа: mc-black ICQ: 308-534-060 Вопросов: 20 Ответов: 1860 |
Web-сайт: Профиль | | #8 | Добавлено: 14.01.08 12:06 |
| GetTickCount, конечно хорошо, но для единиц времени всё же лучше SetTimer & KillTimer. Пример могу немного позже, если ещё нужен. | ||
|
Номер ответа: 9 Автор ответа: ТаняICQ: 410031407 Вопросов: 11 Ответов: 23 |
Профиль | | #9 | Добавлено: 14.01.08 13:04 |
| Да, конечно нужен пример | ||
|
Номер ответа: 10 Автор ответа: el-pasoВопросов: 3 Ответов: 164 |
Профиль | | #10 | Добавлено: 14.01.08 16:06 |
|
имхо, в VB попытка передать адрес процедуры в функцию API грозит очередным геммороем..
Чем плох вариант с тиками? Мне кажется, что ничем. |
||
|
Номер ответа: 11 Автор ответа: mc-blackICQ: 308-534-060 Вопросов: 20 Ответов: 1860 |
Web-сайт: Профиль | | #11 | Добавлено: 15.01.08 10:11 |
|
Обещанный код
В модуле листа: Option Explicit
Private Declare Function SetTimer Lib "user32" (ByVal hwnd As Long, ByVal nIDEvent As Long, ByVal uElapse As Long, ByVal lpTimerFunc As Long) As Long Private Declare Function KillTimer Lib "user32" (ByVal hwnd As Long, ByVal nIDEvent As Long) As Long Dim myTimerID As Long Private Sub Worksheet_Activate() myTimerID = SetTimer(0, 0, 300, AddressOf TimerProc) End Sub Private Sub Worksheet_Deactivate() If KillTimer(0, myTimerID) = 0 Then MsgBox ("KillTimer Error" 
End Sub В модуле "Module1": Option Explicit
Public Function TimerProc(hwnd As Long, uMsg As Long, idEvent As Long, dwTime As Long) As Long On Error Resume Next If ThisWorkbook.Worksheets("Лист1" .Cells(1, 1).Interior.ColorIndex = 3 Then
ThisWorkbook.Worksheets("Лист1" .Cells(1, 1).Interior.ColorIndex = 2
Else ThisWorkbook.Worksheets("Лист1" .Cells(1, 1).Interior.ColorIndex = 3
End If TimerProc = 0 End Function |
||
|
Номер ответа: 12 Автор ответа: mc-blackICQ: 308-534-060 Вопросов: 20 Ответов: 1860 |
Web-сайт: Профиль | | #12 | Добавлено: 15.01.08 10:29 |
|
el-paso, чтобы без гемороя, надо Callback-функцию помещать в программный модуль, а не в модули листов/книг. Хотя, конечно, AddressOf лучше бы была реализована как функция, чем как унарный оператор для списка параметров.
Чем плох GetTickCount? Больше операций в единицу времени, управляемый цикл - выше загрузка процессора, плохо смотрится DoEvents. Получается, что чем более производительная система, тем больше раз провернется цикл в секунду. Таймер срабатывает в строго указанные интервалы времени и процессор грузится только на выполнении операций по мерцанию. |
||
|
Номер ответа: 13 Автор ответа: GenyaAВопросов: 0 Ответов: 185 |
Web-сайт: Профиль | | #13 | Добавлено: 16.01.08 07:59 |
| А сделать то же самое на OnTime методе было бы еще проще, мне кажется, т.к. не не нужно было бы и Declare. | ||
|
Номер ответа: 14 Автор ответа: mc-blackICQ: 308-534-060 Вопросов: 20 Ответов: 1860 |
Web-сайт: Профиль | | #14 | Добавлено: 16.01.08 08:22 |
| Проще, но с OnTime интервал мерцания меньше одной секунды не сделаешь. А предыдущие два примера дозируют задержку пульсации в миллисекундах. | ||
Страница: 1 |