- Joined
- May 28, 2011
- Messages
- 2
- Reaction score
- 0
I want to move some images from Excel to PowerPoint using VBA. I have got the following code which Opens the powerpoint file goes to the sheet mentioned in the code, but not able to paste the image in PowerPoint. Can someone please help me with this? Thanks.
This code is wokring fine in terms of copying the image, opening the powerpoint file, selecting the sheet mentioned, but not able to paste the image in powerpoint.
------------------------------------------------------------------------------------------------------------------------
Sub CopyTable()
Selection.CopyPicture Appearance:=xlScreen, Format:=xlPicture
Call CreateObjectExample
End Sub
Sub CreateObjectExample()
Dim objApp As Object
Const ERR_APP_NOTFOUND As Long = 429
On Error Resume Next
' Attempt to create late-bound instance of Access application.
Set objApp = CreateObject("PowerPoint.Application")
If Err = ERR_APP_NOTFOUND Then
MsgBox "Power Point isn't installed on this computer. Could not automate PowerPoint."
Exit Sub
End If
With objApp
.Activate
.Presentations.Open Filename:="C:\Users\karmakaa\Desktop\Reports\OGM\Template.pptx", ReadOnly:=msoFalse
.ActivePresentation.Slides(2).Select
.Activate
.ActivePresentation.SaveAs Filename:="C:\Users\karmakaa\Desktop\Reports\OGM\Template2.pptx"
.Quit
End With
Set objApp = Nothing
End Sub
This code is wokring fine in terms of copying the image, opening the powerpoint file, selecting the sheet mentioned, but not able to paste the image in powerpoint.
------------------------------------------------------------------------------------------------------------------------
Sub CopyTable()
Selection.CopyPicture Appearance:=xlScreen, Format:=xlPicture
Call CreateObjectExample
End Sub
Sub CreateObjectExample()
Dim objApp As Object
Const ERR_APP_NOTFOUND As Long = 429
On Error Resume Next
' Attempt to create late-bound instance of Access application.
Set objApp = CreateObject("PowerPoint.Application")
If Err = ERR_APP_NOTFOUND Then
MsgBox "Power Point isn't installed on this computer. Could not automate PowerPoint."
Exit Sub
End If
With objApp
.Activate
.Presentations.Open Filename:="C:\Users\karmakaa\Desktop\Reports\OGM\Template.pptx", ReadOnly:=msoFalse
.ActivePresentation.Slides(2).Select
.Activate
.ActivePresentation.SaveAs Filename:="C:\Users\karmakaa\Desktop\Reports\OGM\Template2.pptx"
.Quit
End With
Set objApp = Nothing
End Sub