Exvel VBA to Powerpoint slides

[mahmed1]

Hi ZVI,

I have created another thread as advised

To recap - I need to copy my ranges as picture or best quality and paste it into my PP Templat Pres

I have a PP Template which contains 2 sheets (Title sheet with a text box named TitleText) and Content Slide with a textbox named ContentText

I found some code online that does some of this but this creates a new powerpoint presentation and pastes it there. My condition is slightly diff where I need to 1st update the Titke slide text and then use the Content slide template to paste each slide in as the text and theme is pre-formatted

I then need to resize my image so it looks nice and not overlapping the slide

This is the code I found - I tried to add my bits of code attempt in there and have commented bits where I would need to change to suit me (I have left the original code that I found in there for ref)

Hopefully this will make more sense

This is the code

Sub CreatePowerPointPresentation()
Dim DasboardSh As Worksheet
Dim Weekdash As Worksheet
Dim CalcSh As Worksheet
Dim MyTitle As Range
Dim PPTitleTextRange As Range
Dim PPCopyRange As Range
Dim PowerPointApp As Object
Dim PPTemmplatePath As String
Dim TitleTextRow As Long
Dim CopyPictureRow As Long
Set DasboardSh = Worksheets("DAILY SUMMARY")
Set Weekdash = Worksheets("WEEK DASHBOARD")
Set CalcSh = Worksheets("CALCULATION")
Set MyTitle = CalcSh.Range("TITLETEXT")
Set PPTitleTextRange = CalcSh.Range("PPTITLE")
'Set PPCopyRange = CalcSh.Range("COPYRANGE")
'Create an Instance of PowerPoint
  On Error Resume Next
    
    'Is PowerPoint Template already opened?
      
      'This is where i need to open up my PP Template but is its open then set a ref to it
      'Set PowerPointApp = GetObject("PowerPoint.Application")
    
    'Clear the error between errors
      Err.Clear
    'If PowerPoint is not already open then open PowerPoint
      'This is where i need to open up my PP Template but is its open then set a ref to it
      'If PowerPointApp Is Nothing Then Set PowerPointApp = CreateObject("PowerPoint.Application")
    
    'Handle if the PowerPoint Application is not found
      If Err.Number = 429 Then
        MsgBox "PowerPoint could not be found, aborting."
        Exit Sub
      End If
  On Error GoTo 0
'Make PowerPoint Template Visible and Active
  
  'PowerPointApp.Visible = True
  'PowerPointApp.Activate
  
'Create a New Presentation
  'Set myPresentation = PowerPointApp.Presentations.Add
'Create a copy of Slide 1 (Title Slide) to the end of the slide - i have renamed the text box to TitleText
  'Set mySlide = myPresentation.Slides.Add(1, 11) '11 = ppLayoutTitleOnly
  
'Add the MyTitle.value to TitleText
   
'CopyRanges
For i = 2 To 11
    'SlideTitle = CalcSh.Range("U" & i)
    'Create copy of Content Slide (Slide) - i have named the text box ContextText
    'Add the text SlideTitle to ContextText
    
    'Set PPCopyRange = Weekdash.Range("V" & i)
    
    'Copy Excel Range
    'PPCopyRange.Copy
    
    'I need to Paste to this content slide and resize and position
    
    'Set mySlide = myPresentation.Slides.Add(1, 11) '11 = ppLayoutTitleOnly
    'Set myShapeRange = mySlide.Shapes(mySlide.Shapes.Count)
    
    'mySlide.Shapes.PasteSpecial DataType:=2
    
Next i
  
 
End Sub

 

[ZVI]

Hi Mahmed,

In your earlier post the Powerpoint Template called Company Template has been mentioned.

Is it the Company Template.POTX file or Company Template.PPTX file?
Is it stored in the same folder with Excel workbook?

You wrote that the heading names for each section of presentation is in Dashboard sheet range K1:K15.
I would suggest putting addresses of the copied ranges into L1:L15 as well. Is it suitable?

 

[mahmed1]

Hi Mahmed,

In your earlier post the Powerpoint Template called Company Template has been mentioned.

Is it the Company Template.POTX file or Company Template.PPTX file?
Is it stored in the same folder with Excel workbook?

You wrote that the heading names for each section of presentation is in Dashboard sheet range K1:K15.
I would suggest putting addresses of the copied ranges into L1:L15 as well. Is it suitable?

Hi ZVI- I have re-jigged it to make it more better to access the range

I have defined the file name and path
Const PPTemplatePath As String = "desktop\DI MONTHLY REPORTS (CODE)\COMPANY DASHBOARD.pptx" (PPTX FILE)

On the calculation sheet - I have named cell S1 (TITLETEXT) - This is the title text for the title Slide (1st Slide) - I have named the shape on that slide (TitleText)

In Calculation sheet U2:U11 (I have listed the title text for each slide) - I have named this range PPTITLES
In Calculation sheet V2:V11 (I have listed all the named ranges that I need to copy - all these named ranges refer to the worksheet WEEK DASH) - I have named this range COPYRANGE

E.g say V2 has ATTENDANCERANGE - This is already referring to a range of cells in the worksheet WEEK DASH - I have already named these cells and have just pasted the name of the named ranges in CELL V2:V11

I have tried to modify the code but getting stuck on pasting over the text box

This is my further attempt

Set MyTitle = CalcSh.Range("TITLETEXT")

'Create duplicate of 1st slide
Set MyPresentation = PowerPointApp.Presentations.Open(PPTemplatePath)
    
'Add the MyTitle.value to TitleText

MyPresentation.Slides(1).Duplicate

' I am trying to move it at the end but this don't work
Set mySlide = MyPresentation.Slides.Paste(MyPresentation.Slides.Count + 1)

' I am trying to change the text but this aint working either
mySlide.Shapes("TitleText").TextFrame.TextRange.Text = MyTitle.Value

'CopyRanges

For i = 2 To 11
    
    SlideTitle = CalcSh.Range("U" & i).Value
    
    'Create copy of Content Slide (Slide) - i have named the text box ContextText and move to the end

    Set ContentSlide = MyPresentation.Slides(2).Duplicate
    'Add the text SlideTitle to ContextText but this aint working
mySlide.Shapes("ContentText").TextFrame.TextRange.Text = CalcSh.range("U" & I).value

    
    'Set PPCopyRange = Weekdash.Range("V" & i)
    
    'Copy Excel Range
    'PPCopyRange.Copy
    
    'I need to Paste to this to this content slide and resize and position
    
    'Set mySlide = myPresentation.Slides.Add(1, 11) '11 = ppLayoutTitleOnly
    'Set myShapeRange = mySlide.Shapes(mySlide.Shapes.Count)
    
    'mySlide.Shapes.PasteSpecial DataType:=2
    
Next i
 


Move on to next range and slide

 

[ZVI]

Please answer that question: Is template stored in the same folder with Excel workbook?

 

[ZVI]

Here is full the code:

Sub ExcelToPP()
' ZVI:2016-09-23 http://www.mrexcel.com/forum/excel-questions/966393-exvel-visual-basic-applications-powerpoint-slides.html
 
  '--> Setttings, change to suit
  Const Ws = "Calculation"                  ' Worksheet's name
  Const Title1 = "TITLETEXT"                ' Range for Title of the 1st slide
  Const Data = "PPTITLES"                   ' Range for Titles with Addresses/Names on the next column
  Const Template = "COMPANY DASHBOARD.pptx" ' Template of Presentation with two Slides
  Const TemplatePath = ""                   ' Path or an empty string if Tempalete is in the folder of workbook
  '<-- End of Settings
 
  Dim objPowerPoint As Object, objPresentation As Object
  Dim i As Long
  Dim f As String
  Dim a(), v, w, h, t
 
  ' Determine PathName to the template of the presentation
  If Len(TemplatePath) > 0 Then
    f = TemplatePath
    If LCase(Left(f, 8)) = "desktop\" Then
      f = Environ("USERPROFILE") & Mid(f, 8)
    End If
  Else
    f = ActiveWorkbook.Path
  End If
  If Right(f, 1) <> "\" Then f = f & "\"
  f = f & Template
  ' Check it presense
  If Len(Dir(f)) = 0 Then
    MsgBox "Template Presentation not found:" & vbLf & f, vbExclamation, "Exit"
    Exit Sub
  End If
 
  ' Find/Create PowerPoint instance of Application
  On Error Resume Next
  Set objPowerPoint = GetObject(, "PowerPoint.Application")
  If Err Then
    Set objPowerPoint = CreateObject("PowerPoint.Application")
    objPowerPoint.Visible = True
  End If
  On Error GoTo 0
   
  ' Open template of the presentation
  Set objPresentation = objPowerPoint.Presentations.Open(f)
  With objPresentation.PageSetup
    h = .SlideHeight
    w = .SlideWidth
  End With
 
  ' Prepare Slides
  a() = Range(Data).Resize(, 2).Value
 
  ' Prepare Slide #1
  With objPresentation.Slides(1).Shapes(1)
    ' Title for Slide #1 is in the 1st cell of Range(Ref)
    .TextFrame.TextRange.Text = Range(Title1).Value
    t = .Top + .Height
  End With
 
  ' Copy slide #2
  With objPresentation.Slides(2)
    For i = 2 To UBound(a)
      .Duplicate
    Next
  End With
 
  ' Put content to the slides
  With objPresentation.Slides
    For i = 1 To UBound(a)
      .Item(i + 1).Shapes(1).TextFrame.TextRange.Text = a(i, 1)
      Range(a(i, 2)).Copy
      With .Item(i + 1).Shapes.PasteSpecial(DataType:=2)
        .LockAspectRatio = msoFalse
        .Top = t
        .Left = 0
        .Width = w
        .Height = h - t
      End With
      Application.CutCopyMode = False
    Next
  End With
 
  ' Activate PP
  objPowerPoint.Activate
 
  ' Save it
  objPresentation.SaveAs Left(f, Len(f) - 4) & Format(Now, "yymmdd_hhmmss") & ".pptx"
 
  ' Empty memory of object variables
  Set objPresentation = Nothing
  Set objPowerPoint = Nothing
   
End Sub

 

[ZVI]

Remove Const Ws = "Calculation" from the code as it is not used

 

[mahmed1]

Thank you so so so much

I will test when i get home

couple of Qs

I have excel 2007 at home and 2013 at work, does that make a difference or will your code work on that version also?

With the range(a(i,2)).copy part
do i need to specify the sheet im copying from (WEEK DASH) or does it know to pick up the data range from that sheet?
I just realised that only my 1st range to copy comes from a different sheet (DAILY SUMMARY) sheet hemce the reason why i asked if the sheet needs to be specified where im copying from?


At present both the template and excel workbook are on my desktop but i will put into a central location where others can access once i have got everything working fine

if i created a folder in there shared drive and had a the template sheet and excel sheet in there aswel as a folder called Dashboard History - can i save each PowerPoint presentation in there so its kept in 1 place - if there is a template already created for that date then i dont need to create the PP report..

 

[ZVI]

Should work in Excell 2007 too.
If named ranges are used then it will work without sheet reference

 

[mahmed1]

Thank you man - your a legend

When i get home i will test it

I guess il need to have another If statement to see if the report was already run or is already created in the folder i will be saving to

With the outlook part where i need to copy the range into the body..its the 1st copy range only that needs to go into the body ..that copyrange is s snapshot of what happened the previous day

rather than attach the workbook to save space - i suppose if there was a i way i could attach the folder path as a hyperlink in the body, that would be better

 

[mahmed1]

Man I love you (in a nice friendly way)

The code you provided does exactlly what i want - theres just a couple of things i realised..(i tested this on my laptop which has a much smaller screeen then the one i have at work so not sure if the same would happen at work)

Some of the picture slides need to have the height increased as the text is showing too small and some need pushing up slightly from the bottom the bottom and some pushed increase height and push up to the middle

now is there a way i can capture the height and width of the picture and how high it is from top and left so that this way i can hard code each slide height / width / top / left so that it comes out nicely?

If this is not the best way then hopefully you can advise a better way to do this..

on on my laptop i resized each one - the reason why some were ok n some wernt is because the picture copy range for each 1 were different therefore by increasing height/width/top/left on some were different to others..

Other than that..the PowerPoint presentation opened at a zoom of 70 - i guess id want that to be 100%..

Again i dont know if its because im testimg this on my laptop but hopefully youll no better than me..

Ps - I need to check to see if the PowerPoint slide already exists in the folder i want to save it in - if it does then i dont need to create the PP Report

1 last bit id need is to copy the workbook as an attachment and Copythe range called DASHBOARD RANGE into the body of the email

The code is awesome - thank you so so so so much