Intermittent VBA Makro Fehler

Question

Ich habe den folgenden Code geschrieben, um durch meine Arbeitsblätter als eine Art Diashow zu durchlaufen, um in einer Verkaufsabteilung zu verwenden. Der Code funktioniert perfekt, wenn ich im Debug-Modus durchlaufe, aber wenn ich das Makro ausführe, funktioniert es nur zeitweise und kommt gelegentlich zur Auswahl der Arbeitsblätter, ohne die Bildschirmaktualisierungs-Anwendungsfunktion reaktiviert zu haben.

Hier ist der Code, den ich bisher erstellt haben:

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

ich einige einfache Code zusammen, die gut etwas Ähnliches und arbeitet tut. Sie können von hier aus bauen - stellen Sie Fragen, wenn Sie etwas nicht verstehen.

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