PowerPoint O365 - v16 Prevent Screen Updating

Question

I am creating shapes on a PowerPoint slide from Excel but it is incredibly slow because each shape is drawn and the screen is updating very slowly. I'm using office 365.

I have seen various posts pointing to the link below - but it appears to be for older versions. Even adding in another line for version 16 isn't doing anything

Case "16"
          hWnd = FindWindow("PPTFrameClass", 0&)

PowerPoint VBA Equivalent of Application.ScreenUpdating

Has anyone managed to get this working so I can run Excel VBA, updating PowerPoint without any screen flicker and fast speeds.

Hope there is a solution to this.

Edit: Here is some sample code to run that shows the sort of thing I'm doing. Just need to add reference to Microsoft PowerPoint 16.0 Object Library

Option Explicit
Public PPT As PowerPoint.Application
Public PRES As PowerPoint.presentation
Public SLIDE As PowerPoint.SLIDE
Public CANV As PowerPoint.Shape
Public SHP As PowerPoint.Shape

Sub OpenPowerPoint()
  Set PPT = CreateObject("Powerpoint.Application")
  Set PRES = PPT.Presentations.Add
  PPT.Visible = True
  Set SLIDE = PRES.Slides.Add(PPT.ActivePresentation.Slides.Count + 1, ppLayoutText)
End Sub

Sub CreatePPTShapes()
  If PRES Is Nothing Then OpenPowerPoint
  
  Dim l As Long, t As Long, w As Long, h As Long, x As Long
  Dim size As Long, m As Long, nm As String
  Dim startDate As Long
  startDate = DateSerial(2021, 4, 1)
    
  l = 5
  t = 70
  w = PRES.PageSetup.SlideWidth - 10
  h = PRES.PageSetup.SlideHeight - 75
  
  Set CANV = SLIDE.Shapes.AddShape(msoShapeRectangle, l, t, w, h)

  With CANV
    .Name = "ta_canvas"
    With .Fill
      .Visible = msoTrue
      .ForeColor.RGB = RGB(240, 240, 240)
      .Transparency = 0
      .Solid
    End With
    With .Line
      .Visible = msoTrue
      .ForeColor.RGB = RGB(0, 0, 0)
      .Transparency = 0.5
      .Weight = 0.25
    End With
  End With
  
  t = t + 5
  w = (w) / 12
  h = 20
  
  For x = 0 To 2
    For m = 0 To 11
      nm = MonthName(Month(DateAdd("m", m, startDate)), True)
      
      t = 70 + 7 + (x * 25)
      l = 10 + (w * m)
      
      Dim newPos As Long
      
      Set SHP = SLIDE.Shapes.AddShape(msoShapeRoundedRectangle, l, t, w, h)
      With SHP
          .Name = "ta_" & nm
          .Adjustments(1) = 0.25
          .Line.Visible = msoFalse
          .Fill.Visible = True
          .Fill.ForeColor.RGB = RGB(0, 0, 0)
          With .TextFrame2
            .TextRange.Characters.Text = nm
            .MarginLeft = 2.8346456693
            .MarginRight = 2.8346456693
            .MarginTop = 0
            .MarginBottom = 0
            .WordWrap = msoFalse
            .AutoSize = msoAutoSizeShapeToFitText
            With .TextRange.ParagraphFormat
              .FirstLineIndent = 0
              .Alignment = msoAlignCenter
            End With
              .VerticalAnchor = msoAnchorMiddle
              With .TextRange.Font
                .size = 12
                With .Fill
                  .Visible = msoTrue
                  .ForeColor.RGB = RGB(255, 255, 255)
                End With
              End With
          End With
      End With
    Next m
  Next x
  
End Sub

Without seeing your code, it's hard to provide help. Scroll about halfway down this page for an alternative method of disabling the screen: answers.microsoft.com/en-us/msoffice/forum/… Or open the PowerPoint file without opening a window by setting WithWindow to False. — John Korchok
I've create a sample module that will show the sort of thing I'm doing. Will edit response. — alketraz

Andy Robertson Andy Robertson · Accepted Answer · 2021-07-13T14:36:24

I've found that if I switch the view in code to the handout master then the code runs much much quicker. It looks like the screen updating is suspended.

ppt.activewindow.viewtype = ppviewhandoutmaster

then switch it back at the end to ppViewNormal or whichever your preferred default view.

PowerPoint O365 - v16 Prevent Screen Updating

1 Answers