VBA PowerPoint Slide Looping from Excel

[scotts]

Hi all,

I am currently pasting data into certain Powerpoint tables from certain cells using VBA

The common factor is that a row of data gets pasted into a single slide (i.e. Row 3 in excel then is pasted into Slide 2). At which point they all increase by 1 (row 4 into slide 3 etc.)

I have put the code together to copy and paste, format and count the number of rows needed (and duplicate the slides to the number I need corresponding with the rows)

But Im missing how I move from slide 1 to 2 in order to paste the data in. Ive tried active slide etc but cannot get anything to move to the next slide. I can get my data to move down the rows in excel but all that happens is it is pasted over the data in slide 1 over and over again!!

Any help on the code / loop for this would be amazing

For reference I have row_count to tell me how many rows of dat I have and this also uses Slide_count to duplicate the slides before pasting (using newslide) so just this final piece of the jigsaw to go and I'm struggling!

Thanks in advance

 

[par60056]

here is what I do:

Dim ppSlide As Slide

Set ppSlide = ppPres.Slides(1)
        With ppSlide
            .Shapes("Report Period").TextFrame2.TextRange.Text = Mid(formatPeriod(thePeriod, 2), 2)
            .SlideShowTransition.EntryEffect = ppEffectFadeSmoothly
            .SlideShowTransition.Duration = 0.7
        End With

Just change the slide number

 

[scotts]

Hi , thanks for the response. I think my explanation may not have ben the best as Im not looking at transitions or controlling a presentation as such.

But your code is locked away in my code vault!!

 

[par60056]

What I did in my template PPTX file was create standard slides with a named field on it. I open the template, read in the Template Pages, then go through the sheets in Excel (you will go through rows) insert a new page and paste place the Excel information in the field on the slide reserved for it. In the example above it set the "Report Period" cell on the template slide. Obviously Most of the information is proprietary so I only showed setting the one field.

What I am doing is taking an image of a range in Excel (usually a table 15 rows by 10-20 columns) and pasting it into the reserved area of the template slide.

Here is a bit more of the code:

Dim ppApp As PowerPoint.Application
Dim ppPres As Presentation
Dim ppSlide As Slide
Dim ppContentSlide As Slide
Dim ppReportLayout As CustomLayout
Dim ppCommentLayout As CustomLayout
Dim ppContentLayout As CustomLayout
Dim template As String
Dim currSlide As Integer

' Create instance of PowerPoint
Set ppApp = CreateObject("Powerpoint.Application")
        
' Create the presentation
Set ppPres = ppApp.Presentations.Open(template, msoFalse)
Set ppReportLayout = ppPres.SlideMaster.CustomLayouts(findLayout(ppPres.SlideMaster.CustomLayouts, "Chart Slide"))
Set ppCommentLayout = ppPres.SlideMaster.CustomLayouts(findLayout(ppPres.SlideMaster.CustomLayouts, "Notes Slide"))
Set ppContentLayout = 

'for each sheet/row
      Set ppSlide = ppPres.Slides.AddSlide(currSlide, ppReportLayout)
      ppSlide.SlideShowTransition.EntryEffect = ppEffectFadeSmoothly
      ppSlide.SlideShowTransition.Duration = 0.7
      ppSlide.Shapes("Text Placeholder 7").TextFrame2.TextRange.Text = "Report Date: " & Format(Now, "dd-mmm-yyyy")
      ppSlide.Shapes("Text Placeholder 8").TextFrame2.TextRange.Text = "Report Period: " & Mid(formatPeriod(thePeriod, 2), 2)
      currSlide = currSlide + 1
      With ppSlide
           .Shapes("Title 3").TextFrame2.WordWrap = msoFalse
           .Shapes("Title 3").TextFrame2.TextRange.Text = sh.Cells(1, 1)
           .Shapes("Text Placeholder 2").TextFrame2.WordWrap = msoFalse
           .Shapes("Text Placeholder 2").TextFrame2.AutoSize = msoAutoSizeTextToFitShape
           .Shapes("Text Placeholder 2").TextFrame2.TextRange.Text = sh.Cells(2, 1)
           .Shapes("Text Placeholder 4").Delete
           .Shapes("Text Placeholder 5").Delete
           ptTop = .Shapes("Picture Placeholder 1").Top
           ptLeft = .Shapes("Picture Placeholder 1").Left
           ptHeight = .Shapes("Picture Placeholder 1").Height
           ptWidth = .Shapes("Picture Placeholder 1").Width
                       
           sh.Range(sh.Cells(4, 1), sh.Cells(rangeEnd, lastCol)).CopyPicture
                       
           ppSlide.Shapes.Paste

           '  the new pasted object will be the last object ID on the slide
           ppSlide.Shapes(ppSlide.Shapes.Count).Top = ptTop
           ppSlide.Shapes(ppSlide.Shapes.Count).Left = ptLeft
           If (ppSlide.Shapes(ppSlide.Shapes.Count).Height > ptHeight) Then
                resizeFactor = ptHeight / ppSlide.Shapes(ppSlide.Shapes.Count).Height
                ppSlide.Shapes(ppSlide.Shapes.Count).Height = ppSlide.Shapes(ppSlide.Shapes.Count).Height * resizeFactor
           End If
               
           If (ppSlide.Shapes(ppSlide.Shapes.Count).Width > ptWidth) Then
                 resizeFactor = ptWidth / ppSlide.Shapes(ppSlide.Shapes.Count).Width
                 ppSlide.Shapes(ppSlide.Shapes.Count).Width = ppSlide.Shapes(ppSlide.Shapes.Count).Width * resizeFactor
           End If
           .Shapes("Picture Placeholder 1").Delete
                        
      End With

Hope this helps you along.

 

[scotts]

Hi again, this will be a huge help, this is my first real attempt at producing something meaningful so its a steep learning curve, but one Im enjoying!!

Thank you for taking the time to share your knowledge, it really is appreciated

 

[par60056]

It is a steep learning curve. There are not many people using Excel to create PPT presentations. I learned it largely by trial and error about 4 years ago. It may not be the best way to do it but it works.

Good luck