DoEvents прерывает мигание анимации - PullRequest
4 голосов
/ 11 мая 2019

Я написал некоторый простой код в 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 (необходим для принудительной перерисовки экрана для анимации).

Анимация вызывается из определенных событий изменения рабочего листа, и если вызывается второй экземпляр подпрограммы (или фактическикажется, что если происходит какое-либо событие), первое завершается наполовину завершенным и никогда не заканчивается - это означает, что временная фигура никогда не удаляется.

Вот иллюстрация, показывающая, о чем я говорю: Demo Gif

Как обойти это?

1 Ответ

1 голос
/ 11 мая 2019

Это скорее тренировка, чем решение, но она выполняет свою работу, технически говоря

Если вы отключите пользовательский ввод во время выполнения процедуры flashbox, он будет ждать окончания анимации и только затем снова ее активировать, чтобы избежать анимации, оставшейся замороженной

Private Sub Worksheet_Change(ByVal Target As Range)
    Application.Interactive = False
    flashBox Target, ColorConstants.vbMagenta
    Application.Interactive = True
End Sub

enter image description here

Я посмотрю, смогу ли я решить это "правильно", но сейчас, наконец, это хороший обходной путь :)

...