Wednesday, 10 September 2014

How to Generate PowerPoint Slides for each Chart in Active Sheet with Excel VBA Macro

Excel VBA Macro to Generate PowerPoint Slides for each Chart in Active Sheet
Suppose In a Workbook Sheet if we have some Charts.
Now if you want the Generate the Power Point Slides for each Chart , and we can use the following Macro :
This Macro will generate the Slide for each Chart in Active Sheet and Save the Presentation in active Workbook Path with Workbook Name.
Sub Create_PPT_Charts_Activesheet()
 Dim New_PowerPoint As Object
 Dim PPT_Present As Powerpoint.Presentation
 Dim ActiveSlide As Powerpoint.Slide
 Dim Cht As Excel.ChartObject
 SavePath = ThisWorkbook.Path
 Present_Name = ThisWorkbook.Name
On Error Resume Next
   'Set New_PowerPoint = GetObject(, "PowerPoint.Application")
Set New_PowerPoint = CreateObject("PowerPoint.Application")

On Error GoTo 0
If New_PowerPoint Is Nothing Then
        Set New_PowerPoint = New Powerpoint.Application
End If

If New_PowerPoint.Presentations.Count = 0 Then
        Set PPT_Present = New_PowerPoint.Presentations.Add
       'Set PPT_Present = New_PowerPoint.Presentations.Open("C:\Users\Tamatam\Downloads\Temp.pptx")
End If
New_PowerPoint.Visible = True

'Loop through each chart in the Excel worksheet and paste them into the PowerPoint
For Each Cht In ActiveSheet.ChartObjects        
New_PowerPoint.ActivePresentation.Slides.Add New_PowerPoint.ActivePresentation.Slides.Count + 1, ppLayoutText

New_PowerPoint.ActiveWindow.View.GotoSlide New_PowerPoint.ActivePresentation.Slides.Count
Set ActiveSlide = New_PowerPoint.ActivePresentation.Slides(New_PowerPoint.ActivePresentation.Slides.Count)

'Deleting Title and Body Text boxes from PPT Slide if Not require.
 ActiveSlide.Shapes(1).Delete 'Deleting shape(1)from PPTslide
 ActiveSlide.Shapes(1).Delete 'Deleting shape(2) from PPTslide
'Copy the chart and paste it into the PowerPoint as a Picture

'<< Pasting with Source Formatting >>

             PPT_Slide.Application.CommandBars.ExecuteMso ("PasteSourceFormatting")

'Adjusting the positioning of the Chart on Powerpoint Slide
New_PowerPoint.ActiveWindow.Selection.ShapeRange.LockAspectRatio = msoFalse
New_PowerPoint.ActiveWindow.Selection.ShapeRange.Width = 620
New_PowerPoint.ActiveWindow.Selection.ShapeRange.Height = 400
New_PowerPoint.ActiveWindow.Selection.ShapeRange.Left = 55
New_PowerPoint.ActiveWindow.Selection.ShapeRange.Top = 65
Next Cht

PPT_Present.SaveAs SavePath & "\" & Present_Name & ".pptx"

Set PPT_Present = Nothing
Set ActiveSlide = Nothing
'Closing the Powepoint Application Window
Set New_PowerPoint = Nothing
MsgBox " Each Chart from Active is Printed on PowerPoint Slides", vbOKOnly, "PPTs Generated Successfully"
End Sub

      [ BI-Reporting Analyst ]

No comments:

Post a Comment

Follow Me by Email

ExcelKingdom-Popular Posts

ExcelKingdom-Random Posts