Ошибка прерывистой макросов VBA

Question

Я написал приведенный ниже код, чтобы просмотреть мои рабочие листы как своего рода слайд-шоу для использования в отделе продаж. Код работает отлично, когда я перехожу в режим отладки, однако, когда я запускаю макрос, он работает только с перерывами, иногда получая выбор рабочих листов без повторной активации функции обновления экрана.

Вот код, который я создал до сих пор:

Sub Runshow() 

Dim ws As Worksheet 

On Error GoTo exit_ 
Application.EnableCancelKey = xlErrorHandler 

For Each ws In ThisWorkbook.Worksheets 
    ws.Protect 
Next 

Application.DisplayFullScreen = True 
Application.DisplayFormulaBar = False 
ActiveWindow.DisplayWorkbookTabs = False 
ActiveWindow.DisplayHeadings = False 
ActiveWindow.DisplayGridlines = False 
ActiveWindow.DisplayHorizontalScrollBar = False 
ActiveWindow.DisplayVerticalScrollBar = False 
Application.Calculation = xlManual 

Let y = 0 
Do Until y = 80 

    Application.ScreenUpdating = False 

    Workbooks.Open("c:\users\admin\downloads\crm.xlsx").Activate 
    Application.Calculate 

    ActiveWorkbook.Close savechanges = False 
    Application.ScreenUpdating = True 
    ThisWorkbook.Activate 

    Let x = 0 
    Do Until x = 23 

     For Each ws In ActiveWorkbook.Worksheets 
      ws.Select 
      Application.Wait (Now + TimeValue("00:00:10")) 
      x = x + 1 
     Next 

    Loop 

    y = y + 1 
Loop 

exit_: 

For Each ws In ThisWorkbook.Worksheets 
    ws.Unprotect 
Next 

Application.DisplayFullScreen = False 
Application.DisplayFormulaBar = True 
ActiveWindow.DisplayWorkbookTabs = True 
ActiveWindow.DisplayGridlines = True 
ActiveWindow.DisplayHorizontalScrollBar = True 
ActiveWindow.DisplayVerticalScrollBar = True 
Application.Calculation = xlAutomatic 

End Sub 

Answer 1

Я собрал простой код, который делает что-то подобное, и работает хорошо. Вы можете построить отсюда - задавайте любые вопросы, если вы ничего не понимаете.

Sub Slideshow() 
    Dim ws As Worksheet 

    PrepareView True 

    For Each ws In ThisWorkbook.Worksheets 
     ws.Activate 
     Application.Wait (Now + TimeValue("00:00:10")) 
    Next ws 

    PrepareView False 
End Sub 

Function PrepareView(status As Boolean) 
    If status = True Then 
     ActiveWindow.DisplayWorkbookTabs = False 
     ActiveWindow.DisplayHeadings = False 
     ActiveWindow.DisplayGridlines = False 
     ActiveWindow.DisplayHorizontalScrollBar = False 
     ActiveWindow.DisplayVerticalScrollBar = False 
    ElseIf status = False Then 
     Application.DisplayFullScreen = False 
     Application.DisplayFormulaBar = True 
     ActiveWindow.DisplayWorkbookTabs = True 
     ActiveWindow.DisplayGridlines = True 
     ActiveWindow.DisplayHorizontalScrollBar = True 
     ActiveWindow.DisplayVerticalScrollBar = True 
    End If 
End Function