Change button appereance only while running macro-CodePudding

I have a shape in excel which acts as a button to run a VBScript macro. I'd like to change the bevel and shadow while the macro is running to make it seem like the button was physically pressed. I feel like this should be an easy one to solve but I don't understand why my code isn't working:

Sub Welcome_Begin()
    Sheets("Welcome").Select
    With ActiveSheet.Shapes.Range(Array("Welcome_Begin_Button"))
         .ThreeD.BevelTopInset = 0
         .ThreeD.BevelTopDepth = 0
         With .Shadow
             .OffsetX = 0
             .OffsetY = 0
         End With
     End With
     Application.ScreenUpdating = False

     < code goes here >

     Sheets("Welcome").Select
     Application.ScreenUpdating = True
     With ActiveSheet.Shapes.Range(Array("Welcome_Begin_Button"))
         With .Shadow
             .OffsetX = 1.2246467991E-16
             .OffsetY = 2
         End With
         .ThreeD.BevelTopInset = 1
         .ThreeD.BevelTopDepth = 0.5
     End With
End Sub

With this code, it should change the appearance of the button before pausing screen update and running the code. I have tested the upper and lower blocks individually to ensure that the code will correctly change the appearance of the button, so I don't know why the button doesn't change before pausing screen updates...

Here's what it looks like:

This is what it should look like when pressed:

Any ideas?

CodePudding user response：

This is the best I could do, but it does add an additional 1sec delay to the run. If you try to reduce that below 1sec you will find you lose the button transition while the rest of the code is running.

Const BTN_NM As String = "Welcome_Begin_Button"

Dim runTime

'Button entry point
Sub Welcome_Begin1()
    
    If runTime <> 0 Then Exit Sub 'run already scheduled
    
    Clicked ActiveSheet.Shapes(BTN_NM)             'set button as "clicked"
    
    runTime = Now   TimeSerial(0, 0, 1)            'set global variable
    Application.OnTime runTime, "Welcome_Begin2"   'call with 1 sec delay
End Sub

'main button code here...
Sub Welcome_Begin2()
    Dim i As Long
    
    Application.ScreenUpdating = False
    
    For i = 1 To 2000 'do something long-ish
        ActiveSheet.Range("A1").Value = i
        DoEvents
    Next i
    
    Clicked ActiveSheet.Shapes(BTN_NM), False 'reset button
    
    'might want to add an error handler to ensure this next line gets run...
    runTime = 0                               'clear scheduled time

End Sub


'format a shape as "clicked" or "not clicked"
Sub Clicked(btn As Shape, Optional IsOn As Boolean = True)
    Dim scrUpd
    scrUpd = Application.ScreenUpdating
    Debug.Print "ScreenUpdating", scrUpd
    Application.ScreenUpdating = True 'make sure this is on
    With btn
        .ThreeD.BevelTopInset = IIf(IsOn, 0, 1)
        .ThreeD.BevelTopDepth = IIf(IsOn, 0, 1.5)
        With .Shadow
            .OffsetX = IIf(IsOn, 0, 2)
            .OffsetY = IIf(IsOn, 0, 1.5)
        End With
    End With
    DoEvents
    Application.ScreenUpdating = scrUpd 'reset screenupdating
End Sub