Я написал некоторый простой код в Excel VBA, чтобы сделать диапазон «вспыхивающим» цветом - это достигается путем тщательного рисования прямоугольного объекта над рассматриваемым диапазоном и изменения его прозрачности для постепенного исчезновения прямоугольника.
Вот код (в Sheet1
для события Worksheet_Change
):
Option Explicit
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Private Sub flashBox(ByVal area As Range, Optional ByVal fillColour As MsoRGBType = vbGreen)
Const animationSeconds As Single = 0.5
Const animationSteps As Long = 20
With area.Worksheet.Shapes.AddShape(msoShapeRectangle, area.Left, area.Top, _
Application.WorksheetFunction.Min(area.Width, 1000), _
Application.WorksheetFunction.Min(area.Height, 1000)) 'stop infinite boxes, could use view area to define this
.Line.Visible = msoFalse
.Fill.ForeColor.RGB = fillColour
Dim i As Long
For i = 1 To animationSteps
Sleep animationSeconds * 1000 / animationSteps
.Fill.Transparency = i / animationSteps
DoEvents 'screen repaint
Next i
.Delete
End With
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
flashBox Target, ColorConstants.vbMagenta
End Sub
Я использую блок With
, чтобы содержать временный объект без родительской переменной (я думаю, что этодовольно аккуратный и будет надеяться, что так оно и будет).Проблема возникает из-за вызова DoEvents
(необходим для принудительной перерисовки экрана для анимации).
Анимация вызывается из определенных событий изменения рабочего листа, и если вызывается второй экземпляр подпрограммы (или фактическикажется, что если происходит какое-либо событие), первое завершается наполовину завершенным и никогда не заканчивается - это означает, что временная фигура никогда не удаляется.
Вот иллюстрация, показывающая, о чем я говорю:
Как обойти это?