Routine to automatically pull images and put in placeholders in powerpoint

So I had this issue the other night where a routine I have been using and tweaking over the past few years stopped working.  It is really relatively simple- about 150 lines of code but the core of the routine that put the images into the slides stopped working Monday. I am using office 365 x64 bit.

Figured it out how to get it working again - apparently there is a glitch in VBA - and an old approach started working again and by adding 0.1 second waits, the routine is working (so very odd). Being x64 office may be part of the issue, but it was working at the beginning of the year.
Here is the heart o the code that actually inserts the images:
    For Each ObjFile In ObjFolder.Files
        If ObjFile.Name Like "*.png" Then
            Set pre = Application.ActivePresentation
            ''This sets the slide type:
            Set ObjSlide = pre.Slides.Add(Index:=pre.Slides.Count + 1, Layout:=ppLayoutChart)
                ObjSlide.Shapes(1).TextFrame.TextRange = ObjFile.Name '' "Title of Slide"
            ''add the picture- which doesn't add it to the shape
            With ObjSlide.Shapes.AddPicture(FileName:=ObjFile.Path, LinkToFile:=msoFalse, _
                SaveWithDocument:=msoCTrue, Left:=0, Top:=0, Width:=-1, Height:=-1)
                ''then we CUT the image
                .Cut
            End With
            Wait 0.1
            ''this worked for a while but stooped a few months ago kindof works again...
            ''Have to activate the slide to select a placeholder
            ObjSlide.Select
            Wait 0.1
            ''Have to activate the slide again or it fails to select a placeholder
            ObjSlide.Select
            Wait 0.1
            ''This selects the name of the frame we want to use to put the image in -
            '' there are several of these
            ObjSlide.Shapes("Chart Placeholder 2").Select
            Wait 0.1
            ''paste the clipboard into the active placeholder
            ObjSlide.Shapes.Paste
        End If
    Next ObjFile
Here is the WAIT routine:
Sub Wait(Seconds As Double)
   Dim start
   start = Timer
   While Timer < start + Seconds
      DoEvents
   Wend
End Sub

Comments

Popular posts from this blog

Powerpoint countdown and current time in slides VBA

Revit area plans adding new types and references (Gross and rentable)

Revit Python in Visual Studio Revit Stubs 2022 for Python Revit Intellisense