Question

我的形状有文字“正在加载......”和背景颜色＃000000 alpha = 0.5，与FHD屏幕一样大。

我打算在用户执行耗时的功能时显示它（如你所见，从其他地方加载数据和脏工作），并在vba完成其工作后再次隐藏它。

但它根本没有在开头显示，只是在vba完成后再次显示并隐藏起来。

是的，我使用MsgBox一直检查，真的，只在最后显示和隐藏。

问题：

1）这只发生在我身上吗？

2）如果（1）没有，为什么会发生这种情况？形状/ OLE层仅在末尾刷新（* 1）？技术细节将不胜感激。

3）如果我坚持让这个形状完成它的工作，可能在Excel 2007中？怎么样？

4）替代解决方案（* 3）？只是不要告诉我。

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

* 1）我的意思是“在最后刷新”，Excel，收集所有形状隐藏/显示事件并一次完成。因此，如果我保持隐藏并在某些耗时的功能中显示相同的形状，则结果是闪烁眨眼〜

* 2）下面的示例代码。我能分享的最短的一个。 'Notes让您了解我要做的事情，MsgBox向您展示我的检查点。

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）全球设置到每张纸。

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

非常感谢。

解决方案：

将Application.Wait Now + TimeValue("00:00:01")添加到每个Sheets("Item.Genre").Shapes("OLE_Loading").Visible = True。形状将显示为设计但仍然有1~2秒滞后。不知道为什么。

Answer 1

我编辑了我的回复，我相信这就是你要找的东西实际上，我注意到当你调用另一个子程序时，形状没有显示出来尽管如此，引入1秒的“等待”解决了这个问题。

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

如果您获得预期结果，请告诉我。

Answer 2

更改width，然后刷新形状。样品：

ThisWorkbook.Sheets(1).Shapes("Oval 1").DrawingObject.Width = xxx

形状/ OLE层何时更新？

2 个答案: