Copy data range from Excel to PPT using VBA - vba

I'm using MS Excel for Mac V15.32 on macOS Sierra V10.12.3.
I'm trying to apply a practice example of VBA code to move data from Excel to PPT. It's breaking about halfway through on the following line:
PPSlide.Shapes.Paste.Select
The error message is "Run-time error '424': Object required".
I tried using a snippet of code from an answer to a similar question (Copy Charts from Excel to PPT using VBA Macro), but that just crashed both applications. That code is commented out in Step 5. Code below and file here: https://www.dropbox.com/s/7maeqlkiciyxhwy/CopyDataToPPT.xlsm?dl=0.
Thanks for your help,
David
--
`' http://www.dummies.com/software/microsoft-office/excel/sending-
excel-data-to-a-powerpoint-presentation/
Sub CopyRangeToPresentation()
'Step 1: Declare your variables
Dim PP As PowerPoint.Application
Dim PPPres As PowerPoint.Presentation
Dim PPSlide As PowerPoint.Slide
Dim SlideTitle As String
'Step 2: Open PowerPoint and create new presentation
Set PP = New PowerPoint.Application
Set PPPres = PP.Presentations.Add
PP.Visible = True
'Step 3: Add new slide as slide 1 and set focus to it
Set PPSlide = PPPres.Slides.Add(1, ppLayoutTitleOnly)
PPSlide.Select
'Step 4: Copy the range as a picture
Sheets("Slide Data").Range("A1:J28").CopyPicture _
Appearance:=xlScreen, Format:=xlPicture
'Step 5: Paste the picture and adjust its position
PPSlide.Shapes.Paste.Select
'PPPres.Slides(PPPres.Slides.Count).Shapes.Paste
PP.ActiveWindow.Selection.ShapeRange.Align msoAlignCenters, True
PP.ActiveWindow.Selection.ShapeRange.Align msoAlignMiddles, True
'Step 6: Add the title to the slide
SlideTitle = "My First PowerPoint Slide"
PPSlide.Shapes.Title.TextFrame.TextRange.Text = SlideTitle
'Step 7: Memory Cleanup
PP.Activate
Set PPSlide = Nothing
Set PPPres = Nothing
Set PP = Nothing
End Sub
--

Related

Import multiple excel ranges/sheets to powerpoint

I have an excel workbook with 20 sheets and I am trying to import these excel sheets into powerpoint using a VBA. I've been able to compose a piece of code which does almost exactly what I need to do, however I am unable to find the solution for the last part.. Hope you guys can help me out!
From each sheet I need to select a different range (which is visible in cell A1 and A2 of each sheet).
for example from excel sheet 1 I have in cell A1 "B3" and in cell A2 "D12", which means that for this sheet the VBA should copy range B3:D12.
In the next sheet exactly the same should happen, however it should adjust its range based on what I've given up in cell A1 and A2 of that sheet.
My code so far is as follows:
Sub PrintPPT()
'Step 1: Declare variables
Dim pp As Object
Dim PPPres As Object
Dim PPSlide As Object
Dim xlwksht As Worksheet
Dim MyRange As String
Dim Cval1 As Variant
Dim Cval2 As Variant
Dim Rng1 As Range
'Step 2: Open PowerPoint, add a new presentation and make visible
Set pp = CreateObject("PowerPoint.Application")
Set PPPres = pp.Presentations.Add
pp.Visible = True
'Step 3: Set the ranges for the data
Cval1 = ActiveSheet.Range("A1").Value
Cval2 = ActiveSheet.Range("A2").Value
Set Rng1 = ActiveSheet.Range("Cval1 : Cval2")
MyRange = "Rng1"
'Step 4: Start the loop through each worksheet
For Each xlwksht In ActiveWorkbook.Worksheets
xlwksht.Select
Application.Wait (Now + TimeValue("0:00:1"))
'Step 5: Copy the range as picture
xlwksht.Range(MyRange).Copy
'Step 6: Count slides and add new blank slide as next available slide number
'(the number 12 represents the enumeration for a Blank Slide)
SlideCount = PPPres.Slides.Count
Set PPSlide = PPPres.Slides.Add(SlideCount + 1, 12)
PPSlide.Select
'Step 7: Paste the picture and adjust its position
PPPres.ApplyTemplate ("C:\Users\Computer\Documents\Templates\Template.potx")
PPSlide.Shapes.Paste.Select
pp.ActiveWindow.Selection.ShapeRange.Align msoAlignCenters, True
pp.ActiveWindow.Selection.ShapeRange.Top = 80
pp.ActiveWindow.Selection.ShapeRange.Left = 7.2
pp.ActiveWindow.Selection.ShapeRange.Width = 600
'Step 8: Add the title to the slide then move to next worksheet
Next xlwksht
'Step 9: Memory Cleanup
pp.Activate
Set PPSlide = Nothing
Set PPPres = Nothing
Set pp = Nothing
End Sub
IF you want the values in cell A1 And A2, you can't put the variables in quotes when building your range.
Set Rng1 = ActiveSheet.Range("Cval1 : Cval2")
Will give you a Rng1 as Cval1 : Cval2
Set Rng1 = ActiveSheet.Range(Cval1 & ":" & Cval2)
Will give you (from your example) Rng1 = B3:D12
This should be all you need. I haven't tested it, so there may be some tweeking needed.
Sub PrintPPT()
'Step 1: Declare variables
Dim pp As Object
Dim PPPres As Object
Dim PPSlide As Object
Dim xlwksht As Worksheet
Dim MyRange As String
'Step 2: Open PowerPoint, add a new presentation and make visible
Set pp = CreateObject("PowerPoint.Application")
Set PPPres = pp.Presentations.Add
pp.Visible = True
'Step 3: Start the loop through each worksheet
For Each xlwksht In ActiveWorkbook.Worksheets
MyRange = xlwksht.Range("A1").Value & ":" & xlwksht.Range("A2").Value
xlwksht.Range(MyRange).Copy
'Step 4: Count slides and add new blank slide as next available slide number
'(the number 12 represents the enumeration for a Blank Slide)
SlideCount = PPPres.Slides.Count
Set PPSlide = PPPres.Slides.Add(SlideCount + 1, 12)
PPSlide.Select
'Step 5: Paste the picture and adjust its position
PPPres.ApplyTemplate ("C:\Users\Computer\Documents\Templates\Template.potx")
PPSlide.Shapes.Paste.Select
pp.ActiveWindow.Selection.ShapeRange.Align msoAlignCenters, True
pp.ActiveWindow.Selection.ShapeRange.Top = 80
pp.ActiveWindow.Selection.ShapeRange.Left = 7.2
pp.ActiveWindow.Selection.ShapeRange.Width = 600
'Step 6: Add the title to the slide then move to next worksheet
Next xlwksht
'Step 7: Memory Cleanup
pp.Activate
Set PPSlide = Nothing
Set PPPres = Nothing
Set pp = Nothing
End Sub

VBA Excel - Powerpoint export

I've the following piece of code which exports excel sheets to powerpoint. In each sheet it takes the range from cells A1 and A2 and copies that range into powerpoint.
Now I want to add two functions, but I have no clue how to do this, so I am hoping anyone can help me with this?
1 - In sheets where only a table is included, the code does exactly what it's supposed to do. However in some sheets I've included a picture or a chart and these are not properly pasted in excel. (only a blank picture is copied in the powerpoint slide). Now I want to make a code that uses my input from cell "C1" to determine whether this slide needs to be pasted as an image or as a normal paste. I've tried to fix this but my code continuously gets an error. Is there any way that I can adjust this code so that I will get it working?
2 - The code now copies all worksheets, but I want it to start at sheet 7 and continue from there till the end. Thus skipping the first 6 worksheets. Does anyone have a clue how I can exclude these sheets in my VBA?
Sub PrintPPT()
'Step 1: Declare variables
Dim pp As Object
Dim PPPres As Object
Dim PPSlide As Object
Dim xlwksht As Worksheet
Dim MyRange As String
'Step 2: Open PowerPoint, add a new presentation and make visible
Set pp = CreateObject("PowerPoint.Application")
Set PPPres = pp.Presentations.Add
pp.Visible = True
'Step 3: Start the loop through each worksheet
For Each xlwksht In ActiveWorkbook.Worksheets
MyRange = xlwksht.Range("A1").Value & ":" & xlwksht.Range("A2").Value
xlwksht.Range(MyRange).Copy
'Step 4: Count slides and add new blank slide as next available slide number
'(the number 12 represents the enumeration for a Blank Slide)
SlideCount = PPPres.Slides.Count
Set PPSlide = PPPres.Slides.Add(SlideCount + 1, 12)
PPSlide.Select
'Step 5: Paste the picture and adjust its position
PPPres.ApplyTemplate ("C:\Users\Template.potx")
Pastetype = xlwksht.Range("C1").Value
' Pastetype will be "PasteSpecial DataType:=2" for images
' Pastetype will be "Paste.Select" for normal
PPSlide.Shapes.pastetype '2 = ppPasteEnhancedMetafile
'pp.ActiveWindow.Selection.ShapeRange.Align msoAlignCenters, True
pp.ActiveWindow.Selection.ShapeRange.Top = 85
pp.ActiveWindow.Selection.ShapeRange.Left = 7.2
'pp.ActiveWindow.Selection.ShapeRange.Width = 600
'Step 6: Add the title to the slide then move to next worksheet
Next xlwksht
'Step 7: Memory Cleanup
pp.Activate
Set PPSlide = Nothing
Set PPPres = Nothing
Set pp = Nothing
End Sub

VBA: Copy + Paste Selected Charts from Excel to Powerpoint

I am looking to copy and paste selected charts from Excel 2010 to Powerpoint 2010 as Microsoft Excel Chart Object formats into an active PPT slide. Ideally, I would like to be able to place these charts into specific positions on the active Powerpoint slide. I've scrounged the web but all if not most solutions are for all slides in a sheet to be pasted randomly on a PPT slide. I don't even have a code but if anyone can help, that would be awesome. Thanks!
Well, here's something: This is a pptGenerator-class that I wrote some time back.
In my scenario I wanted to right click specific charts in a workbook, have "Copy to presentation" as an option in a custom context menu, and add subsequent charts on subsequent slides in either the same presentation, or a new one.
These charts were captured in another class in order to create the context menu and have itself copied to the slide when passed to it.
Below is a slightly modified and stripped version, that should help you out to fix your specific situation by editing this class.
In a Class module:
'PowerPoint Generator class - Rik Sportel
'Maintains a PowerPoint application for Excel workbook.
Private WithEvents pptApp As PowerPoint.Application
Private ppt As PowerPoint.Presentation
Private pptPresentations As Collection 'Collection to add presentations to
Private p_currentPresentation As Boolean
'Make sure you don't add slides if there is no presentation.
Public Property Get CurrentPresentation() As Boolean
CurrentPresentation = p_currentPresentation
End Property
'Initialization
Private Sub Class_Initialize()
p_currentPresentation = False
Set pptApp = New PowerPoint.Application
Set pptPresentations = New Collection
End Sub
'Termination
Private Sub Class_Terminate()
Set pptPresentations = Nothing
Set pptApp = Nothing
End Sub
'Creates a new Presentation in the powerpoint app, and adds it to the pptPresentations collection. Add methods later to cycle through them.
Public Sub NewPresentation()
Set ppt = pptApp.Presentations.Add
pptPresentations.Add ppt
'Create presentation and use image stored within the current workbook as a background for it.
ThisWorkbook.Worksheets("BGItems").Shapes(1).Copy 'Copy the background
ppt.Windows(1).ViewType = ppViewSlideMaster
ppt.Windows(1).View.Paste 'Paste the background
ppt.Windows(1).ViewType = ppViewNormal
p_currentPresentation = True
End Sub
'Add a slide to the presentation, place passed chart on it.
Public Sub AddSlide(chartForSlide As Chart)
Dim nSlide As PowerPoint.Slide
Dim nChart As PowerPoint.Shape
'Create a new slide with the chart on it.
Set nSlide = pptApp.ActivePresentation.Slides.Add(1, ppLayoutBlank)
chartForSlide.ChartArea.Copy
nSlide.Shapes.Paste 'Paste the chart
Set nChart = nSlide.Shapes(1)
'Position the chart
With nChart
.Left = ppt.PageSetup.SlideWidth / 10
.top = ppt.PageSetup.SlideHeight / 10
.Width = ppt.PageSetup.SlideWidth / 100 * 80
.Height = ppt.PageSetup.SlideHeight / 2
End With
Set nChart = Nothing
Set nSlide = Nothing
End Sub
'Make sure to keep track of presentations properly if users interact with
'powerpoint in unexpected ways. Capture event and make sure the presentation object you write to will still exist.
Private Sub pptApp_PresentationClose(ByVal Pres As PowerPoint.Presentation)
For i = pptPresentations.Count To 1 Step -1
If pptPresentations.Item(i) Is Pres Then
pptPresentations.Remove i
End If
Next i
If Pres Is ppt Then
Set ppt = Nothing
p_currentPresentation = False
End If
End Sub
In my "factory" module. a regular code module:
Public Sub GetPowerpoint()
If pptApp Is Nothing Then Set pptApp = New pptGenerator
End Sub
How it's used:
'Pass a chart + optionally if it has to be a new presentation:
Public Sub CopyChartToPpt(tChart As Chart, Optional newPres As Boolean)
GetPowerpoint
If pptApp.CurrentPresentation = False Then pptApp.NewPresentation
If newPres = True Then pptApp.NewPresentation
pptApp.AddSlide tChart
End Sub
So where and how you obtain the selected chart is another thing, but as long as you manage to select the Chart from the ChartObject or Slide in your workbook, and pass it as a parameter to the above, you should be abled to fix it according to your own specs.
Other than my advise would be to check the VBA reference for your powerpoint version over at MSDN.
So here's a solution that worked for me. The macro copy + pastes selected range or chart into the active PowerPoint slide into a certain position. This reason I wanted to do this is that each quarter/month we generate reports for our clients and this helps to reduce the time required for copying + pasting and making the deck look nice. Hope this helps anyone else who make a ton of PPTs!
'Export and position into Active Powerpoint
'Prior to running macro, enable Microsoft Powerpoint Object Library in Tools - Reference
'Identifies selection as either range or chart
Sub ButtonToPresentation()
If TypeName(Selection) = "Range" Then
Call RangeToPresentation
Else
Call ChartToPresentation
End If
End Sub
Sub RangeToPresentation()
Dim PPApp As PowerPoint.Application
Dim PPPres As PowerPoint.Presentation
Dim PPSlide As PowerPoint.Slide
'Error message if range is not selected
If Not TypeName(Selection) = "Range" Then
MsgBox "Please select a worksheet range and try again."
Else
'Reference existing instance of PowerPoint
Set PPApp = GetObject(, "Powerpoint.Application")
'Reference active presentation
Set PPPres = PPApp.ActivePresentation
'Reference active slide
Set PPSlide = PPPres.Slides(PPApp.ActiveWindow.Selection.SlideRange.SlideIndex)
'Copy the range as a picture
Selection.CopyPicture Appearance:=xlScreen, _
Format:=xlBitmap
'Paste the range
PPSlide.Shapes.Paste.Select
'Align the pasted range
PPApp.ActiveWindow.Selection.ShapeRange.Align msoAlignCenters, True
PPApp.ActiveWindow.Selection.ShapeRange.Align msoAlignMiddles, True
' Clean up
Set PPSlide = Nothing
Set PPPres = Nothing
Set PPApp = Nothing
End If
End Sub
Sub ChartToPresentation()
'Uses Late Binding to the PowerPoint Object Model
'No reference required to PowerPoint Object Library
Dim PPApp As Object 'As PowerPoint.Application
Dim PPPres As Object 'As PowerPoint.Presentation
Dim PPSlide As Object 'As PowerPoint.Slide
'Error message if chart is not selected
If ActiveChart Is Nothing Then
MsgBox "Please select a chart and try again."
Else
'Reference existing instance of PowerPoint
Set PPApp = GetObject(, "Powerpoint.Application")
'Reference active presentation
Set PPPres = PPApp.ActivePresentation
'PPApp.ActiveWindow.ViewType = 1 ' 1 = ppViewSlide
'Reference active slide
Set PPSlide = PPPres.Slides _
(PPApp.ActiveWindow.Selection.SlideRange.SlideIndex)
'Copy chart as a picture
ActiveChart.CopyPicture Appearance:=xlScreen, Size:=xlScreen, _
Format:=xlPicture
'Paste chart
PPSlide.Shapes.Paste.Select
'Align pasted chart
PPApp.ActiveWindow.Selection.ShapeRange.Align msoAlignCenters, True
PPApp.ActiveWindow.Selection.ShapeRange.Align msoAlignMiddles, True
' Clean up
Set PPSlide = Nothing
Set PPPres = Nothing
Set PPApp = Nothing
End If
End Sub

how to paste table from excel to powerpoint 2007 as default using vba

I want to paste table from excel to powerpoint using vba.
I am using powerpoint version 2007.
I am able to successfully paste ppEnhancedmeta file.
But getting problem while pasting to ppPasteDefault.
** It gives error "Shapes (unknown member): invalid request. clipboard is empty or contains data which may not be pasted here**
Sub excel_to_powerpoint()
Dim PPApp As PowerPoint.Application
Dim PPPres As PowerPoint.Presentation
Dim PPSlide As PowerPoint.Slide
Set PPApp = New PowerPoint.Application
PPApp.Visible = True
PPApp.Activate
Set PPPres = PPApp.Presentations.Add
Set PPSlide = PPPres.Slides.Add(1, ppLayoutBlank)
Sheet2.Range("A1:C5").Copy
For i = 1 To 50000: DoEvents: Next
PPSlide.Shapes.PasteSpecial ppPasteDefault
Set myshape = PPSlide.Shapes(PPSlide.Shapes.Count)
myshape.Left = 50
myshape.Top = 50
Application.CutCopyMode = False
End Sub
Somebody have any idea where i am doing wrong.
Thanks
I figure it out.
I don't know where the problem occur.
But the solution that work for me is to replce
PPSlide.Shapes.PasteSpecial ppPasteDefault
with
PPApp.ActiveWindow.View.PasteSpecial DataType:=ppPasteDefault
Thanks
Try
PPSlide.Shapes.PasteSpecial DataType:=ppPasteOLEObject, Link:=msoFalse
Instead of
PPSlide.Shapes.PasteSpecial ppPasteDefault
This works for me on MS office 2010 however I don't have 2007 as you do so this may not work.
Found this code here
Hope it helps

How to Copy paste data range from Excel to powerpoint slide

I am trying to prepare code to copy and paste excel data range from excel sheet to powerpoint slide but I am able to paste images only.
Please help with the suitable code. The code I am using is as follows:
Sub WorkbooktoPowerPoint()
Dim pp As Object
Dim PPPres As Object
Dim PPSlide As Object
Dim Rng As Range
Set pp = CreateObject("PowerPoint.Application")
Set PPPres = pp.Presentations.Add
pp.Visible = True
Set Rng = ActiveSheet.Range("B1:J31")
Rng.Copy
SlideCount = PPPres.Slides.Count
Set PPSlide = PPPres.Slides.Add(SlideCount + 1, 12)
PPSlide.Shapes.PasteSpecial ppPasteOLEObject
PPSlide.Shapes(1).Select
pp.ActiveWindow.Selection.ShapeRange.Align msoAlignTops, True
pp.ActiveWindow.Selection.ShapeRange.Top = 65
pp.ActiveWindow.Selection.ShapeRange.Left = 7.2
pp.ActiveWindow.Selection.ShapeRange.Width = 700
pp.Activate
Set PPSlide = Nothing
Set PPPres = Nothing
Set pp = Nothing
End Sub
It still surprises me that many of the PasteSpecial options are not available form the clipboard or in PowerPoint generally. I think there is a way around this using a different method. Instead of:
PPSlide.Shapes.PasteSpecial ppPasteOLEObject
Try using this method:
PPSlide.Parent.CommandBars.ExecuteMso "PasteExcelTableSourceFormatting"
I am not certain of the correct idMso argument to use but I would start with that, it looks like it works the way I would expect it to:
PowerPoint Result
Excel Table Example
If not, there are several others that might be worth checking:
PasteSourceFormatting
PasteDestinationTheme
PasteAsEmbedded
PasteExcelTableSourceFormatting
PasteExcelTableDestinationTableStyle
This method is not as well-documented compared to many other methods. The Application.CommandBars property reference has nary a mention of the ExecuteMso method, which I found some information about here (and on SO where I have seen it used once or twice before):
The full list of idMso parameters to explore, which come as part of a rather large executable for use with fluent ribbon UI design, current for Office 2013 I believe:
http://www.microsoft.com/en-us/download/details.aspx?id=727
Another method for getting the data from Excel to PPT slides without VBA code also possible.
Note: save both workbook and PPT file in one location.
Step 1: Copy excel data / table
Step 2: Go to Power point slides
Step 3: Select Paste special option
Step 4: Select "Paste Link" radio button
Step 5: Click on Ok
Then save the files then change the data in excel, now it will automatically copy the data based linking the connection.
Hope this option helps.
Thanks,
Gourish
To take an Excel range and paste it into a PowerPoint Application, requires breaking down the process into a few different parts. Looking at your code, we can break it down to the following components:
Create an instance of PowerPoint.
Create your slide & presentation.
Create a reference to the range you want to export & then copy it.
Align the shape to the desired dimensions.
Finally, release your objects from memory.
I am assuming that you want this code left as late-binding, but there are also sections of your code that will cause issues because you are treating it like it was written in early-binding.
Also, I have a YouTube video on this topic, so feel free to watch the series if you want to do a more complicated paste or if you're working with multiple Excel Ranges.
Link to Playlist:
https://www.youtube.com/playlist?list=PLcFcktZ0wnNlFcSydYb8bI1AclQ4I38VN
SECTION ONE: DECLARE THE VARIABLES
Here we will just create all the variables we need in our script.
'Declare PowerPoint Variables
Dim PPTApp As Object
Dim PPTPres As Object
Dim PPTSlide As Object
'Dim Excel Variables
Dim ExcRng As Range
SECTION TWO: CREATE A NEW INSTANCE OF POWERPOINT
This will create a new PowerPoint application, make it visible and make it the active window.
'Create a new PowerPoint Application and make it visible.
Set PPTApp = CreateObject("PowerPoint.Application")
PPTApp.Visible = True
PPTApp.Activate
SECTION THREE: CREATE A NEW PRESENTATION & SLIDE
This will add a new presentation to the PowerPoint Application, create a new slide in the presentation and set the layout as a blank layout.
'Create a new Presentation
Set PPTPres = PPTApp.Presentations.Add
'Create a new Slide
Set PPTSlide = PPTPres.Slides.Add(1, 12) '<<< THIS 12 MEANS A BLANK LAYOUT.
SECTION FOUR: CREATE A REFERENCE TO THE EXCEL RANGE & COPY IT
This will set a reference to our Excel range we want to copy and copy it.
'Set a reference to the range
Set ExcRng = Range("B1:J31")
'Copy Range
ExcRng.Copy
SECTION FOUR: PASTE IN SLIDE AS OLEOBJECT
This will paste the range in the slide and set a reference to it.
'Paste the range in the slide
SET PPTShape = PPTSlide.Shapes.PasteSpecial(10) '<<< 10 means OLEOBJECT
SECTION FIVE: ALIGN THE SHAPE
This will select the shape and set the dimensions of it.
'Select the shape.
PPTSlide.Shapes(PPTSlide.Shapes.Count).Select
'Set the Dimensions of the shape.
With PPTApp.ActiveWindow.Selection.ShapeRange
.Top = 65
.Left = 7.2
.Width = 700
End With
SECTION SIX: RELEASE OBJECTS FROM MEMORY
This will release the objects from memory.
'Erase Objects from memory.
Set PPTApp = Nothing
Set PPTSlide = Nothing
Set PPTShape = Nothing
In full, this is how your code will now look:
Sub ExportRangeToPowerPoint_Late()
Dim PPTApp As Object
Dim PPTPres As Object
Dim PPTSlide As Object
Dim PPTShape As Object
Dim ExcRng As Range
'Create a new instance of PowerPoint
Set PPTApp = CreateObject("PowerPoint.Application")
PPTApp.Visible = True
PPTApp.Activate
'Create a new Presentation
Set PPTPres = PPTApp.Presentations.Add
'Create a new Slide
Set PPTSlide = PPTPres.Slides.Add(1, ppLayoutBlank)
'Set a reference to the range
Set ExcRng = Range("B1:J31")
'Copy Range
ExcRng.Copy
'Paste the range in the slide
Set PPTShape = PPTSlide.Shapes.PasteSpecial(10)
'Select the shape.
PPTSlide.Shapes(PPTSlide.Shapes.Count).Select
'Set the Dimensions of the shape.
With PPTApp.ActiveWindow.Selection.ShapeRange
.Top = 65
.Left = 7.2
.Width = 700
End With
'Erase Objects from memory.
Set PPTApp = Nothing
Set PPTSlide = Nothing
Set PPTShape = Nothing
End Sub