CODEWITHSUNDEEP
excelvbacolors
Akinn
Akinn

Reputation: 2068

Cannot change color of a shape in Excel

VBA noob here. I am developing a workbook which makes use of an external dll from my client. In a sheet I have a button that, when pressed, starts a routine which makes a shape orange, then calls the API and finally makes the shape black.

Misteriously, it works only 'few times'.

The following code resides in a sub within a module:

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

I cannot share details about the API. I simply declare with the traditional sintax:

#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

and works perfectly.

The problem is that the first SchemeColor (to 53) does not work meaning that the API is called and the second SchemeColor too (the shape turns black). Just to test, I tried to comment the second SchemeColor (to 0) and I noticed that in this case the shape turns orange AFTER the API is called! That suggested me Excel create a sort of priority queue of the commands to be executed and that the API call is performed before the first SchemeColor: that clearly messes with my flow. Is there a way to force Excel to execute immediately an operation? Is there another reason for the fail?

P.S.: I have executed the first SchemeColor lines of code separately and works nicely so I suppose the code is correct. P.P.S.: I have also tried using RGB instead of SchemeColor, with the same result.

Upvotes: 1

Views: 544

Answers (1)

Sam
Sam

Reputation: 5721

Try this

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

It works with Application.OnTime to start the chain of events without waiting for all of it to end before updating. I have changed some of your code to make it easier to reproduce, but I think you will be able to follow it quite easy.

Upvotes: 1

Related Questions