vba - 全屏编码

Question

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

这是为了在大屏幕上显示统计数据，循环显示多个统计页面。

这在 Excel 2007 和 2010 上完美运行。 然而，当在 Excel 2013 上执行相同的代码时，Excel 只是最大化了我的 CPU 的 1 个核心，并且一直没有响应。我什至无法使用 Escape 来中断代码执行。逐行单步执行代码在所有版本上都可以正常工作。

'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