vba - 全屏编码

Question

我有以下代码全屏加载工作表 1 分钟，然后使用完全相同的方法移动到工作簿中的下一个工作表。

这是在大屏幕上显示统计信息，循环显示几个统计信息页面。

这在 Excel 2007 和 2010 上完美运行。
然而，当在 Excel 2013 上执行相同的代码时，Excel 只是将我的 CPU 的 1 个核心最大化，并且一直没有响应。我什至无法逃脱以破坏代码执行。逐行遍历代码在所有版本上都可以正常工作。

'Loads up Daily Dispatch Figures worksheet
Application.ScreenUpdating = False
Sheets("Daily Dispatch Figures").Select
Range("A1").Select
Range("A1:C36").Select
ActiveWindow.Zoom = True
Range("A1").Select
ActiveWindow.DisplayHeadings = False
Application.DisplayFormulaBar = False
Application.DisplayFullScreen = True
Application.ScreenUpdating = True

' Stays on this screen for 1 min
TimVal = Now + TimeValue("0:01:00")
Do Until Now >= TimVal
Loop

Answer 1

哦，不要这样做:

' Stays on this screen for 1 min
TimVal = Now + TimeValue("0:01:00")
Do Until Now >= TimVal
Loop

尝试这个:

Application.OnTime Now + TimeValue("0:01:00"), "ProcedureToRun"

您不想在没有 sleep 的无限循环中捕获您的应用程序。

任何时候你坐在无限循环中而不 sleep ，它会使用 100% 的处理器时间什么都不做。 Application.OnTime “安排”一个事件并将控制权返回给 Excel UI 线程，而不是无限循环。

你可以在这里阅读更多: https://msdn.microsoft.com/en-us/library/office/ff196165.aspx

我不确定你在循环之后在做什么，但你需要确保你有一个单独的子例程中的代码并调用它。

这是一个转到下一张表的子程序。

Sub MoveNext()
On Error Resume Next
Sheets(ActiveSheet.Index + 1).Activate
If Err.Number <> 0 Then Sheets(1).Activate
On Error Goto 0
End Sub

您可以将 Application.OnTime 添加到它的末尾并让它自己调用:

Sub MoveNext()
On Error Resume Next
Sheets(ActiveSheet.Index + 1).Activate
If Err.Number <> 0 Then Sheets(1).Activate
On Error Goto 0
Application.OnTime Now + TimeValue("00:01:00"), MoveNext
End Sub

这样，它将永远循环并从一张纸到另一张纸(或者直到您以您选择使用的任何方法停止它)。

最后，您可以通过存储预定时间并使用 Scheduled:=False 来取消此操作。 .

您的最终代码可能如下所示:

Public scheduledTime as Date

Sub StartDisplaying()
'Your start code:
'---------------------------------------------
Application.ScreenUpdating = False
Sheets("Daily Dispatch Figures").Select
Range("A1").Select
Range("A1:C36").Select
ActiveWindow.Zoom = True
Range("A1").Select
ActiveWindow.DisplayHeadings = False
Application.DisplayFormulaBar = False
Application.DisplayFullScreen = True
Application.ScreenUpdating = True
'---------------------------------------------
scheduledTime = Now + TimeValue("00:01:00")
Application.OnTime scheduledTime, MoveNext
End Sub

Sub StopDisplaying()
'Your stop code:
'---------------------------------------------
Application.ScreenUpdating = False
Sheets("Daily Dispatch Figures").Select
ActiveWindow.Zoom = False
ActiveWindow.DisplayHeadings = True
Application.DisplayFormulaBar = True
Application.DisplayFullScreen = False
Application.ScreenUpdating = True
'---------------------------------------------
Application.OnTime EarliestTime:=scheduledTime, Procedure:="MoveNext", Schedule:=False
End Sub

Sub MoveNext()
On Error Resume Next
Sheets(ActiveSheet.Index + 1).Activate
If Err.Number <> 0 Then Sheets(1).Activate
On Error Goto 0
scheduledTime = Now + TimeValue("00:01:00")
Application.OnTime scheduledTime, MoveNext
End Sub