0

我有一个带有文本“Now Loading...”和背景颜色#000000 alpha=0.5 的形状,与 FHD 屏幕一样大。

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

但它一开始根本不显示,只是在vba完成后像flash一样再次显示和隐藏。

是的,我用 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 秒的延迟。不知道为什么。

4

2 回答 2

0

我编辑了我的回复,我相信这正是您正在寻找的。
事实上,我注意到当您调用另一个子例程时,形状不会显示。
尽管如此,引入 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

如果你得到预期的结果,请告诉我。

于 2012-07-26T09:34:42.277 回答
0

更改width,然后形状会刷新。样本:

ThisWorkbook.Sheets(1).Shapes("Oval 1").DrawingObject.Width = xxx
于 2013-10-23T06:57:39.063 回答