Мигающая анимация прерывается DoEvents

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

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

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

Как я могу обойти это?


dispose excel vba repaint doevents
person Greedo    schedule 11.05.2019    source источник
comment
@QHarr Конечно, есть код вызывающего абонента, который является событием Worksheet_Change. DoEvents находится в цикле For i.. Next анимации.   -  person Greedo    schedule 11.05.2019
comment
упс! Мне плохо, что я не вижу!   -  person QHarr    schedule 11.05.2019
comment
Не решение, но вам нужно помнить, что VBA работает в одном потоке, а это означает, что поток может делать либо одно, либо другое. Если вы ожидаете, что окно будет продолжать мигать (что делает возможным основной поток), пока вы вызываете какое-то другое событие (запуск макроса, обновление экрана и т. д.), я думаю, вам придется нелегко. Интересный вопрос однако!   -  person Matteo NNZ    schedule 11.05.2019
comment
Человек, это такие моменты, когда вы хотите, чтобы vba поддерживала многопоточность   -  person Samuel Hulla    schedule 11.05.2019
comment
@Rawrplus Расскажите мне об этом;) Хотя на самом деле в этом случае я думаю, что может быть обходной путь   -  person Greedo    schedule 11.05.2019
comment
Очень интересно, что DoEvents вообще предотвращает выполнение второй половины вашего Sub! Обходной путь: присвойте фигуре .AlternativeText = "DeleteMe", чтобы распознать и удалить их все в цикле.   -  person Asger    schedule 12.05.2019

Ответы (1)


arrow_upward
2
arrow_downward

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

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

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

введите здесь описание изображения

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

person Samuel Hulla    schedule 11.05.2019