Powerpoint için ekran görüntülemeyi kapatma

Question

Bir klasörde dolaşan ve bazı ölçütlerden grafikler oluşturan bir komut dosyası yazıyorum ve sonra bunları powerpoint'e aktarıyorum. Şu anda, 130 grafik oluşturmak, 286'sının powerpoint tarafından kullanıldığı 290 saniyeyi alır. Bunun önemli bir neden olduğundan şüpheleniyorum, bu, powerpoint için ekran güncellemesini kapatamıyor. Bunu çözmek için buradan http://skp.mvps.org/ppt00033.htm kodunu kullanmayı denedim. Ancak, herhangi bir etki görmüyorum. Powerpoint'i arka planda saklayabilir ve saklayabilirim, Powerpoint'e geçerken tüm değişiklikler gösteriliyor ve temel olarak programın nasıl yavaşlattığını görebilirsiniz. Bu kodu nasıl kullanacağımı bilen var mı? Bir sınıf modülünde olmalı, başka bir şey yapmalı mıyım, yoksa ne yapıyorum? peşin

Option Explicit 
' UserDefined Error codes 
Const ERR_NO_WINDOW_HANDLE As Long = 1000 
Const ERR_WINDOW_LOCK_FAIL As Long = 1001 
Const ERR_VERSION_NOT_SUPPORTED As Long = 1002 

' API declarations for FindWindow() & LockWindowUpdate() 
' Use FindWindow API to locate the PowerPoint handle. 
Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As Long) As Long 

' Use LockWindowUpdate to prevent/enable window refresh 
Declare Function LockWindowUpdate Lib "user32" (ByVal hwndLock As Long) As Long 

' Use UpdateWindow to force a refresh of the PowerPoint window 
Declare Function UpdateWindow Lib "user32" (ByVal hwnd As Long) As Long 

Property Let ScreenUpdating(State As Boolean) 

Static hwnd As Long 
Dim VersionNo As String 
' Get Version Number 
    If State = False Then 
     VersionNo = Left(Application.Version, InStr(1, Application.Version, ".") - 1) 
     'Get handle to the main application window using ClassName 
     Select Case VersionNo 
     Case "8" 
     ' For PPT97: 
      hwnd = FindWindow("PP97FrameClass", 0&) 
     Case "9" 
     ' For PPT2K: 
      hwnd = FindWindow("PP9FrameClass", 0&) 
     Case "10" 
     ' For XP: 
     hwnd = FindWindow("PP10FrameClass", 0&) 
     Case "11" 
     ' For 2003: 
     hwnd = FindWindow("PP11FrameClass", 0&) 
     Case "12" 
     ' For 2007: 
     hwnd = FindWindow("PP12FrameClass", 0&) 
     Case "14" 
     ' For 2010: 
     hwnd = FindWindow("PPTFrameClass", 0&) 
     Case Else 
     Err.Raise Number:=vbObjectError + ERR_VERSION_NOT_SUPPORTED, _ 
     Description:="Newer version." 
     Exit Property 
     End Select 

     If hwnd = 0 Then 
     Err.Raise Number:=vbObjectError + ERR_NO_WINDOW_HANDLE, _ 
     Description:="Unable to get the PowerPoint Window handle" 
     Exit Property 
     End If 

     If LockWindowUpdate(hwnd) = 0 Then 
       Err.Raise Number:=vbObjectError + ERR_WINDOW_LOCK_FAIL, _ 
     Description:="Unable to set a PowerPoint window lock" 
     Exit Property 
     Else 
     LockWindowUpdate (hwnd) 
     End If 

    Else 
    'Unlock the Window to refresh 
    LockWindowUpdate (0&) 
    UpdateWindow (hwnd) 
    hwnd = 0 
    End If 
End Property 


Sub TestSub() 
' Lock screen redraw 
If ScreenUpdatingOff = True Then ScreenUpdating = False 

' --- Loop through charts in Excel and export them to Powerpoint 
' Redraw screen again 
ScreenUpdating = True 

End Sub 

Çok teşekkürler: Aşağıda ben ödünç almış kod pasajı ve bunu aramaya çalıştığımda nasıl bir örnektir. Bu işlevselliğin kolayca bulunamayacağı konusunda çok garip, şimdi yardımınıza ihtiyacım var!

Answer 1

Class1 adlı bir sınıf modülünde kodunuzu koymak varsayarsak, ... böyle ana kod

Dim myClass1 as Class1 

Set myClass1 = New Class1 

Class1.ScreenUpdating = False 

DÜZENLEMEYİ örneği oluşturmak: aslen yazılmıştır olarak sadece kodu kullanın: gerek herhangi bir şey eklemek. Kötü haber, PPT 2013'teki testlerimde hızın herhangi bir fark yaratmamasıdır. Ancak çalışmayı yanlış olarak ayarlayarak çalıştığını doğrulayabilirsiniz.

Sınıf modülü cScreenUpdating ...

Option Explicit 
' UserDefined Error codes 
Const ERR_NO_WINDOW_HANDLE As Long = 1000 
Const ERR_WINDOW_LOCK_FAIL As Long = 1001 
Const ERR_VERSION_NOT_SUPPORTED As Long = 1002 

' API declarations for FindWindow() & LockWindowUpdate() 
' Use FindWindow API to locate the PowerPoint handle. 
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" _ 
       (ByVal lpClassName As String, _ 
       ByVal lpWindowName As Long) As Long 

' Use LockWindowUpdate to prevent/enable window refresh 
Private Declare Function LockWindowUpdate Lib "user32" _ 
       (ByVal hwndLock As Long) As Long 

' Use UpdateWindow to force a refresh of the PowerPoint window 

Private Declare Function UpdateWindow Lib "user32" (ByVal hWnd As Long) As Long 

Property Let ScreenUpdating(State As Boolean) 

Static hWnd As Long 
Dim VersionNo As String 

' Get Version Number 

    If State = False Then 
    VersionNo = Left(Application.Version, _ 
     InStr(1, Application.Version, ".") - 1) 

    'Get handle to the main application window using ClassName 

    Select Case VersionNo 

     Case "8" 
     ' For PPT97: 
      hWnd = FindWindow("PP97FrameClass", 0&) 
     Case "9" 
     ' For PPT2K: 
      hWnd = FindWindow("PP9FrameClass", 0&) 
     Case "10" 
     ' For XP: 
     hWnd = FindWindow("PP10FrameClass", 0&) 
     Case "11" 
     ' For 2003: 
     hWnd = FindWindow("PP11FrameClass", 0&) 
     Case "12" 
     ' For 2007: 
       hWnd = FindWindow("PP12FrameClass", 0&) 
     Case "14", "15" 
     ' For 2010: 
       hWnd = FindWindow("PPTFrameClass", 0&) 
     Case Else 
     Err.Raise Number:=vbObjectError + ERR_VERSION_NOT_SUPPORTED, _ 
     Description:="Newer version." 
     Exit Property 

    End Select 

    If hWnd = 0 Then 
    ' window was not found... 
     Err.Raise Number:=vbObjectError + ERR_NO_WINDOW_HANDLE, _ 
     Description:="Unable to get the PowerPoint Window handle" 
     Exit Property 
    End If 

    'Attempt to lock the window 
    If LockWindowUpdate(hWnd) = 0 Then 
    ' attempt failed... 
     Err.Raise Number:=vbObjectError + ERR_WINDOW_LOCK_FAIL, _ 
     Description:="Unable to set a PowerPoint window lock" 
     Exit Property 

    End If 

    Else 'State = True 
    'Unlock the Window to refresh 
    LockWindowUpdate (0&) 
    UpdateWindow (hWnd) 
    hWnd = 0 
    End If 

End Property 

Örnek kullanım ...

Set appObject = New cScreenUpdating 
    appObject.ScreenUpdating = False 
    ' code here 
    appObject.ScreenUpdating = True