全屏编码

时间:2015-03-06 16:28:01

标签: excel vba excel-vba

我有以下代码,可以全屏加载工作表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

1 个答案:

答案 0 :(得分:2)

哦,不要这样做:

' 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"

您不希望在没有睡眠的无限循环中捕获您的应用程序。

任何时候你在没有睡觉的情况下坐在无限循环中,它将使用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