Difference makes the DIFFERENCE
Consulting - Quality
Categorised Menu List
Creating a Powerpoint Presentation from Excel
How it works:
based on the code, the spread sheet is formatted into different styles.
to experiment:
- Put some data in excel file
- Graph is generated automatically
- copy and paste the following code
- assign this to a button on screen
- click the button to execute the code.
Context:
To Create a Power point Presentation from Excel. There will be numerous problems involved with this idea., starting with target system screen resolution, version, source version, also depends on patch updates.,
So, this or any of this type of solution can not be perfect (limited to my experience) but useful to impress upon your boss, to tell him that you are working on something innovative.
EXCEL TO POWERPOINT
COPIES DATA AND GRAPHS TO POWERPOINT
Sub CreatePresentation()
Dim ppt As PowerPoint.Application
Dim pres As PowerPoint.Presentation
Dim sSaveAs As String
Dim ws As Worksheet
Dim chrt As Chart
Dim nSlide As Integer
'On Error GoTo ErrHandler
Set ws = ThisWorkbook.Worksheets("Reports")
' Create a new instance of PowerPoint
Set ppt = New PowerPoint.Application
' Create a new presentation
Set pres = ppt.Presentations.Add
'Update this path as per your template stored template ends with extension .potx
pres.ApplyTemplate "D:\Genpact\Templates\Genpact_Template.potx"
With pres.Slides.Add(1, ppLayoutTitle)
.Shapes(1).TextFrame.TextRange.Text = "Quaterly Sales Analysis"
.Shapes(2).TextFrame.TextRange.Text = "10/6/2013"
End With
' Copy data
'CopyDataRange pres, ws.Range("Sales_Summary"), 2, 2
CopyChart pres, ws.ChartObjects(1).Chart, 3, 1
' Save & close the presentation file
sSaveAs = GetSaveAsName("Save As")
If sSaveAs <> "False" Then pres.SaveAs sSaveAs
pres.Close
ExitPoint:
Application.CutCopyMode = False
Set chrt = Nothing
Set ws = Nothing
Set pres = Nothing
Set ppt = Nothing
Exit Sub
Resume ExitPoint
End Sub
Sub CopyDataRange(pres As PowerPoint.Presentation, rg As Range, nSlide As Integer, dScaleFactor As Double)
' copy range to clipboard
rg.Copy
' add new blank slide
pres.Slides.Add nSlide, ppLayoutBlank
' paste the range to the slide
pres.Slides(nSlide).Shapes.PasteSpecial ppPasteOLEObject
' scale the pasted object in PowerPoint
pres.Slides(nSlide).Shapes(1).ScaleHeight dScaleFactor, msoTrue
pres.Slides(nSlide).Shapes(1).ScaleWidth dScaleFactor, msoTrue
' Center Horizontally & Vertically
' Might be a good idea to move this outside this procedure
' so you have more control over whether this happens or not
CenterVertically pres.Slides(nSlide), pres.Slides(nSlide).Shapes(1)
CenterHorizontally pres.Slides(nSlide), pres.Slides(nSlide).Shapes(1)
End Sub
Sub CopyChart(pres As PowerPoint.Presentation, chrt As Chart, nSlide As Integer, dScaleFactor As Double)
' copy chart to clipboard as a picture
chrt.CopyPicture xlScreen
' add slide
pres.Slides.Add nSlide, ppLayoutBlank
' copy chart to PowerPoint
pres.Slides(nSlide).Shapes.PasteSpecial ppPasteDefault
' scale picture
pres.Slides(nSlide).Shapes(1).ScaleHeight dScaleFactor, msoTrue
pres.Slides(nSlide).Shapes(1).ScaleWidth dScaleFactor, msoTrue
' Center Horizontally & Vertically
' Might be a good idea to move this outside this procedure
' so you have more control over whether this happens or not
CenterVertically pres.Slides(nSlide), pres.Slides(nSlide).Shapes(1)
CenterHorizontally pres.Slides(nSlide), pres.Slides(nSlide).Shapes(1)
End Sub
Sub CenterVertically(sl As PowerPoint.Slide, sh As PowerPoint.Shape)
Dim lHeight As Long
lHeight = sl.Parent.PageSetup.SlideHeight
sh.Top = (lHeight - sh.Height) / 2
End Sub
Sub CenterHorizontally(sl As PowerPoint.Slide, sh As PowerPoint.Shape)
Dim lWidth As Long
lWidth = sl.Parent.PageSetup.SlideWidth
sh.Left = (lWidth - sh.Width) / 2
End Sub
Function GetSaveAsName(sTitle As String) As String
Dim sFilter As String
sFilter = "Presentation (*.pptx), *.pptx"
GetSaveAsName = Application.GetSaveAsFilename(filefilter:=sFilter, Title:=sTitle)
End Function
Issues you may encounter: While you copy and paste the code from here to code window, replace double quotes in code window again, as these quotes will appear as smart quotes.
Always take care to check, if required references are checked
I am publishing with a pure intension to help, as the resources on Outlook are very scarce.,
I had to try very hard to even to get very little help., All the code is functional at my end, and I respect every sort of disclaimer, explicitly, I dont take any responsibility what so ever.
It is always advisable to make best use of status bar. Application.StatusBar = "some text"
This will help end user to know that the work is in progress...
