Невозможно изменить цвет фигуры в Excel

Question

VBA нуб здесь. Я разрабатываю рабочую книгу, которая использует внешнюю DLL от моего клиента. На листе у меня есть кнопка, которая при нажатии запускает процедуру, которая делает форму оранжевой, затем вызывает API и, наконец, делает форму черной.

Таинственно, она работает только «несколько раз».

Следующий код находится в подразделе модуля:

Dim shapeToFlash As String
shapeToFlash = "SHAPE " & sheetName
Worksheets("GTE HOME").Shapes(shapeToFlash).Fill.ForeColor.SchemeColor = 53
Worksheets("HOME").Shapes(shapeToFlash).Fill.ForeColor.SchemeColor = 53

// API CALL (kind of long operation ~ 3/4 seconds)

Worksheets("GTE HOME").Shapes(shapeToFlash).Fill.ForeColor.SchemeColor = 0
Worksheets("HOME").Shapes(shapeToFlash).Fill.ForeColor.SchemeColor = 0

Я не могу поделиться информацией об API. Я просто объявляю с традиционным синтаксисом:

#If Win64 Then
Private Declare PtrSafe Function IMB_set_value _
    Lib "path/API.dll" () As Long

#Else
Private Declare Function IMB_set_value _
    Lib "path/API.dll" () As Long

и работает отлично.

Проблема в том, что первый SchemeColor (до 53) не работает, означая, чтоAPI вызывается и второй SchemeColor тоже (форма становится черной). Просто для проверки я попытался прокомментировать второй SchemeColor (до 0) и заметил, что в этом случае форма становится оранжевой ПОСЛЕ вызова API! Это предложило мне Excel создать своего рода очередь с приоритетами для команд, которые нужно выполнить, и что вызов API выполняется перед первым SchemeColor : который явно мешает моему потоку. Есть ли способ заставить Excel немедленно выполнить операцию? Есть ли другая причина сбоя?

PS: Я выполнил первые строки кода SchemeColor отдельно и работает хорошо, поэтому я полагаю, что код правильный. PPS: я также попытался использовать RGB вместо SchemeColor, с тем же результатом.

Answer 1

Попробуйте это

Sub InitiateLongRunningOperation()
    Dim Argument as String

    HighlightShape
    Argument = "Argument Value"        
    Application.OnTime Now, "'LongRunningOperation """ & Argument & """'"
End Sub

Sub HighlightShape()
    Worksheets(1).Shapes(1).Fill.ForeColor.SchemeColor = 53
End Sub

Sub LongRunningOperation(AnArgument As String)
    Debug.Print AnArgument
    ' Replace the line below with your API call
    Application.Wait Now + TimeValue("0:00:03")

    Application.OnTime Now, "ResetShape"
End Sub

Sub ResetShape()
    Worksheets(1).Shapes(1).Fill.ForeColor.SchemeColor = 0
End Sub

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