Excel VBA Pop-Up Shape

Question

My Excel application requires a pop-up screen while it is loading and saving files. I have created a macro, shown below to pop-up a shape. Initially, the oShape.Top location is 300, below the current screen.

I have tried all combinations of the macro & cannot get this oval shape to be visible on the current screen. Oddly, if I create a debug-toggle breakpoint on the last "DoEvents" in this macro, the pop-up will be visible.

Any assistance would be appreciated. Macro is below:

Public Sub TestUP()
    Dim oShape As Shape
    Set oShape = ActiveSheet.Shape("Oal42")
    Application.ScreenUpdating = True
    DoEvents
    NextTime = Now + TimeValue("00:00:05")
    oShape.Visible = True
    oShape.Top = 80
    DoEvents
    NextTime = Now + TimeValue("00"00"05")
    DoEvents
End Sub

score 1 · Answer 1 · answered Oct 13 '20 at 16:53

Your main problem is that a shape is not repainted in the moment you show it, and it seems it is even not repainted when you issue a DoEvent. For a UserForm, there is a Repaint method to force VBA to re-show it, but not for a sheet or a shape.

However, there are tricks to do so. This answer shows 3 possible hacks. I tried Application.WindowState = Application.WindowState and it worked for me. The following code gives an example how you could use it - you can modify the text during runtime.

Option Explicit
Const ShapeName = "Oal42"

Public Sub ShowMsg(msg As String)
    With ActiveSheet.Shapes(ShapeName)

        If .TextFrame2.TextRange.Characters <> msg Then
            .TextFrame2.TextRange.Delete
            .TextFrame2.TextRange.Characters = msg
        End If
          
        .Visible = True
        .Top = 80
        DoEvents
        Application.WindowState = Application.WindowState
    End With
End Sub

Public Sub HideMsg()
    ActiveSheet.Shapes(ShapeName).Visible = False
End Sub

This shows the usage:

Sub testSub()
    ShowMsg "Start"
    Dim i As Long
    For i = 1 To 100 Step 8
        ShowMsg "Working, " & i & "%  done."
        Application.Wait Now + TimeSerial(0, 0, 1)
    Next i
    HideMsg 
End Sub

Excel VBA Pop-Up Shape

1 Answers1