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

Post a Comment

Popular posts from this blog

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

Image
Note to self: Add additional (duplicate) gross area and net area schemed under Area Plans And Area schemes... Really counter-intuitive place to put this instead of say...  Area Plans> New Type> Edit Type (ADD) or Create an area plan, then Go to Properties, Edit Type and Duplicate... Always seem to forget this one! 2015-10-16-And for the calculation type... To update: this also applies to Revit as well as LT- The gross calculations cannot be overridden, however the 'rentable' comes in various flavors... From AD Revit help: Applies to Revit LT 2015 Rules are determined by one type of space bordering another space. The following table shows area measurement rules. To find the appropriate measurement rule, find the selected Area Type and the corresponding Bordering Area Type. Gross Building Area Scheme Types Gross Building Area Scheme Types Area Type Selected Bordering Area Type Measurement Rule Gross Building Area Gross Buil
Read more

Powerpoint countdown and current time in slides VBA

Add text fields- this VBA searches through the objects in the first frame until it finds " " in the text some where, truncates everything from and to the right and replaces it with an active countdown timer or current time in the box. Refreshes every 500ms with a prtsafe call so it doesn't bog down the CPU. Add a slide advance to start the next slide and begin automated slide advancement. Attribute VB_Name = "Countdown" Private Declare PtrSafe Function WaitMessage Lib "user32" () As Long Public Sub Wait ( Seconds As Double ) ''non cpu-intensive wait timer '' https://stackoverflow.com/questions/57268161/sleep-wait-timer-in-powerpoint-vba-thats-not-cpu-intensive Dim endtime As Double endtime = DateTime.Timer + Seconds Do WaitMessage DoEvents Loop While DateTime.Timer < endtime End Sub Sub Countdown_from_Start () Dim Time As Date Dim Count As
Read more

Revit 2019 and up tab colorizer

PYRevit works to tip the tabs tops with a color but not the whole tab so it is not as obvious as I would like but definitely better than nothing! Py revit version is free and available here: https://github.com/eirannejad/pyRevit/releases/tag/v4.7.6 Parallax has an independent Addin as well: $75 Seat or $1500/site license annual. https://www.parallaxteam.com/tabbed-views/ There may be some customization in the API available hereabouts : ) https://thebuildingcoder.typepad.com/blog/2011/02/pimp-my-autocad-or-revit-ribbon.html
Read more