Question

I have a shape with text “Now Loading…” and background color #000000 alpha=0.5, as big as FHD screen.

I was intended to show it when a time consuming function was executed by user (as you can see, load data from somewhere else and dirty works), and hide it again after vba finished its job.

But it doesn’t show at the beginning at all, only show up and hide again like a flash after vba done.

Yes I used MsgBox to check all the way, really, only show up and hide at the very end.

QUESTION:

1) So is this only happening to me?

2) If (1) not, why is this happening? Do the shape/OLE layer only refresh at the end(*1)? Tech detail would be appreciated.

3) If I insist to have this shape do its job, possible in Excel 2007? And how?

4) Alternative solutions(*3)? Just don’t tell me.

Sheets("Sheet1").Range("A1").Value = "Now Loading..."
'balabala
Sheets("Sheet1").Range("A1").Value = "Finish!"

*1) What I mean “refresh at the end” here, is, Excel collects all shape hide/show events and do at one time. So if I keep hide and show the same shape at some time consuming function, it turns out to be blink blink~

*2) Example code below. The shortest one I could share. 'Notes for you to understand what I trying to do, MsgBox to show you my checkpoint.

Sub Item_Genre_Reset_Revise()
'↓ Show the loading notification.
Sheets("Item.Genre").Shapes("OLE_Loading").Visible = True
MsgBox "I thought the shape would show now, but didn't."

'↓ Merge 3 pieces into 1 piece.
Application.ScreenUpdating = False
Sheets("Item.Genre").Range("AJ5:AL37").Value = Sheets("Item.Genre").Range("Q5:S37").Value
Sheets("Item.Genre").Range("AJ38:AL70").Value = Sheets("Item.Genre").Range("V5:X37").Value
Sheets("Item.Genre").Range("AJ71:AL103").Value = Sheets("Item.Genre").Range("AA5:AC37").Value
MsgBox "No. :("

'↓ Sort the mergerd one.
ActiveWorkbook.Worksheets("Item.Genre").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Item.Genre").Sort.SortFields.Add Key:=Range("AJ5:AJ103"), _
    SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
ActiveWorkbook.Worksheets("Item.Genre").Sort.SortFields.Add Key:=Range("AK5:AK103"), _
    SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
ActiveWorkbook.Worksheets("Item.Genre").Sort.SortFields.Add Key:=Range("AL5:AL103"), _
    SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("Item.Genre").Sort
    .SetRange Range("AJ4:AL103")
    .Header = xlYes
    .MatchCase = False
    .Orientation = xlTopToBottom
    .SortMethod = xlPinYin
    .Apply
End With
MsgBox "No. :( :("

'↓ Reload sorted items from internal memory to 3 pieces, as to give up all revise too for another function.
Call Item_Genre_Escape_Internal
MsgBox "No. :( :( :("

'↓ Reset revise counter.
Sheets("Item.Genre").Range("T41").Value = 0
MsgBox "No. :( :( :( :("

Application.ScreenUpdating = True

'↓ Hide the loading notification.
Sheets("Item.Genre").Shapes("OLE_Loading").Visible = False
MsgBox "Now the shape flash!"
End Sub

Sub Item_Genre_Escape_Internal()
Sheets("Item.Genre").Range("Q5:T37").Value = Sheets("Item.Genre").Range("AJ5:AM37").Value
Sheets("Item.Genre").Range("V5:Y37").Value = Sheets("Item.Genre").Range("AJ38:AM70").Value
Sheets("Item.Genre").Range("AA5:AD37").Value = Sheets("Item.Genre").Range("AJ71:AM103").Value
Sheets("Item.Genre").Range("T41").Value = 0
End Sub

*3) Globe setting to every sheets.

Application.DisplayFormulaBar = False
ActiveWindow.DisplayHeadings = False
ActiveWindow.DisplayHorizontalScrollBar = False
ActiveWindow.DisplayVerticalScrollBar = False
Application.DisplayStatusBar = False
ActiveWindow.DisplayWorkbookTabs = False
Worksheets("Item.Genre").Protect Password:="******", _
    UserInterfaceOnly:=True

Thank you very much.

SOLUTION:

Add Application.Wait Now + TimeValue("00:00:01") to each Sheets("Item.Genre").Shapes("OLE_Loading").Visible = True . The shape would show as designed but still got 1~2s lag. Don’t know why.

Answer 1

I edited my reply, and I believe that this is rather what you are looking for.
Indeed, I noticed that the shape doesn’t show when you call another sub routine.
Introducing a “wait” of 1 second solves the problem despite.

Sub Shapes()

Dim oShape              As Shape


Application.ScreenUpdating = True

Set oShape = ThisWorkbook.Sheets(1).Shapes("Oval 1")
oShape.Visible = msoTrue

Application.Wait Now + TimeValue("00:00:01")

Call Other_Sub

oShape.Visible = msoFalse

End Sub

Sub Other_Sub()

Application.Wait Now + TimeValue("00:00:05")

End Sub

Let me know if you get the expected result.