I would like to paste an image into a powerpoint slide, and then resize it once I have it pasted,
I dont know the image idex so it needs to be able to be resized immediately afterr being pasted
below doesnt work, please can someone help
Sub PasteOnSlide()
Dim strPresPath As String
strPresPath = "c://myfile"
Set oPPTFile = oPPTApp.Presentations.Open(strPresPath)
oPPTFile.Slides(4).Shapes.PasteSpecial(ppPasteEnhancedMetafile).select
With Selection
.Height = 270
.Width = 680
.Left = 20
.Top = 120
.ZOrder msoSendToBack
End With
End Sub
i also tried:
set MyShape = oPPTFile.Slides(4).Shapes.PasteSpecial(ppPasteEnhancedMetafile).select
With MyShape
.Height = 270
.Width = 680
.Left = 20
.Top = 120
.ZOrder msoSendToBack
End With
End Sub
Oh so close...
Avoid useing Select, (and declare all your variables!)
Sub PasteOnSlide()
Dim strPresPath As String
Dim MyShape As Shape
Dim oPPTFile As Presentation
Dim oPPTApp As Application
Set oPPTApp = Application
strPresPath = "c://myfile"
Set oPPTFile = oPPTApp.Presentations.Open(strPresPath)
Set MyShape = oPPTFile.Slides(4).Shapes.PasteSpecial(ppPasteEnhancedMetafile).Item(1)
With MyShape
.Height = 270
.Width = 680
.Left = 20
.Top = 120
.ZOrder msoSendToBack
End With
End Sub
You should add error handling, including to cover the case where there is nothing in the clipboard to paste, or where strPresPath does not point to an existing presentation file.
Related
I am using the following code to add a picture and load an image in it on worksheet.
Sub Test()
Dim shp As Shape
Set shp = ActiveSheet.Shapes.AddPicture("Sample.jpg", msoFalse, msoTrue, 100, 100, 100, 100)
shp.Name = "MyPhoto"
End Sub
How can I unload the picture from the shape?
I tried these lines but none worked for me
Sub Unload_Picture()
Dim shp As Shape
Set shp = ActiveWorkbook.Sheets(1).Shapes("MyPhoto")
'shp.Picture = Nothing
'shp.Picture = LoadPicture("")
End Sub
Add image control with vba
Sub ImageCTRL()
Dim Img As OLEObject, pic As MSForms.Image
Dim sh As Worksheet
Set sh = ActiveSheet
With sh
Set Img = .OLEObjects.Add(ClassType:="Forms.Image.1", Link:=False, _
DisplayAsIcon:=False, Left:=20, Top:=20, Width:=400, Height:=400)
With Img
.Name = "MyImg"
Set pic = Img.Object
pic.Picture = LoadPicture("C:\Users\yourpic.pdf Page 1 image 1.jpeg")
End With
End With
End Sub
To change the picture in the control.
Sub changeImg()
Me.MyImg.Picture = LoadPicture("C:\Users\otherpic.jpg")
End Sub
I have these codes in the worksheet module.
The image control has an autofit feature, check the cntrl properties window.
You can also resize the control to a specified size, same as when you added it.
Sub changeImg()
Me.MyImg.Picture = LoadPicture("C:\Users\newPic.jpeg")
With Me.MyImg
.Top = 20
.Left = 20
.Width = 400
.Height = 400
End With
End Sub
My goal: From Microsoft Excel, launch a PowerPoint Presentation ("PP") template. Once the PP file is visible, I am copying the first chart from Microsoft Excel, then adding the first chart to the first PowerPoint slide. The first chart and first slide are working as expected. However, I am taking the second chart from Microsoft Excel and am not able to paste it in the second PP slide because my whole PP application is crashing without an error message. After debugging, I have found that line 53 in the code is causing the error, but I am unsure as to why or how to resolve.
Beginning of the Screenshot:
Ending of the Screenshot and the Beginning of the VBA syntax:
Sub TJT()
Dim PPT_App As PowerPoint.Application
Dim PPT_Pres As PowerPoint.Presentation
Dim PPT_Slide As PowerPoint.Slide
Dim PPT_Shape As PowerPoint.Shape
Dim wk_Book As Workbook
Set wk_Book = ThisWorkbook
Dim slideCount As Integer
slideCount = 1
''''''''''''''''''''''''''''''''''''''''''''
''''''''''''''''SLIDE 1 BEGINNING'''''''''''
''''''''''''''''''''''''''''''''''''''''''''
TemplateFile = "C:\Users\john-doe\Desktop\Default_Template_v0.potx"
Application.ScreenUpdating = False
Set PPT_App = CreateObject("PowerPoint.Application")
Set PPT_Pres = PPT_App.Presentations.Open(TemplateFile, msoFalse, msoTrue)
Set PPT_Slide = PPT_Pres.Slides(slideCount)
PPT_App.Visible = True
Application.Wait (Now + TimeValue("0:00:03"))
Set Chart1 = Worksheets("Inputs").ChartObjects("XY_Return_Vol")
Chart1.Copy
PPT_Slide.Shapes.Paste.Select
With PPT_App.ActiveWindow.Selection.ShapeRange(1)
.LockAspectRatio = False
.Height = 5.2 * 72
.Width = 5.5 * 72
.Left = 1 * 72
.Top = 1.72 * 72
End With
slideCount = slideCount + 1
Set PPT_Shape = Nothing
Set PPT_Slide = Nothing
wk_Book.Application.CutCopyMode = False
PPT_App.ActiveWindow.Selection.Unselect
''''''''''''''''''''''''''''''''''''''''''''
''''''''''''''''SLIDE 2 BEGINNING'''''''''''
''''''''''''''''''''''''''''''''''''''''''''
Set PPT_Slide = PPT_Pres.Slides(slideCount)
PPT_Pres.Slides(slideCount).Select
PPT_App.ActiveWindow.Selection.Unselect
wk_Book.Application.CutCopyMode = True
Set Chart2 = Worksheets("Inputs").ChartObjects("Ann_Ret")
Chart2.Copy
PPT_Slide.Shapes.Paste.Select 'This is line in the code that causes the PowerPoint to crash
With PPT_App.ActiveWindow.Selection.ShapeRange(1)
.LockAspectRatio = False
.Height = 5.2 * 72
.Width = 11.33 * 72
.Left = 1 * 72
.Top = 1.72 * 72
End With
End Sub
Hi i'm making sheet in VBA and I need to fit my open picture to cell from A:59 to F59, i tried change Width and height but it doesn't work nice for me.
Code:
Sub CommandButton1_Click()
Dim fNameAndPath As Variant
Dim img As Picture
fNameAndPath = Application.GetOpenFilename(Title:="Select Picture To Be Imported")
Set img = ActiveSheet.Pictures.Insert(fNameAndPath)
If fNameAndPath = False Then Exit Sub
'Set img = ActiveSheet.Pictures.Insert(fNameAndPath)
With img
With .ShapeRange
.LockAspectRatio = msoTrue
.Width = 125
.Height = 225
End With
.Left = ActiveSheet.Cells(59, 1).Left
.Top = ActiveSheet.Cells(59, 1).Top
.Placement = 1
.PrintObject = True
End With
End Sub
you can simply achieve this using range
.Left = ActiveSheet.Range("B59").Left
.Top = ActiveSheet.Range("F59").Top
I managed to get a picture from Excel to Powerpoint via VBA. This method works perfectly fine. However, I'd like to reposition and resize the second picture.
Could you please help me out?
Sub ExceltoPP()
Dim pptPres As Presentation
Dim strPath As String
Dim strPPTX As String
Dim pptApp As Object
strPath = "D:\"
strPPTX = "Test.pptx"
Set pptApp = New PowerPoint.Application
pptCopy = strPath & strPPTX
pptApp.Presentations.Open Filename:=pptCopy, untitled:=msoTrue
Set pptPres = pptApp.ActivePresentation
Sheets("NEW").Range("Table").CopyPicture xlScreen, xlPicture
pptPres.Slides(2).Select
pptPres.Slides(2).Shapes.PasteSpecial DataType:=ppPasteEnhancedMetafile
Set Graphic = GetObject(, "Powerpoint.Application")
With Graphic.ActiveWindow.Selection.ShapeRange
.Left = 0.39 * 72
.Top = 2 * 72
.Width = 5 * 72
.Height = 2 * 72
End With
Till this part it works perfectly fine. However, when I try to add the second picture, Powerpoint adds the picture, but the repositioning and resizing does not work.
Sheets("NEW").Range("A1:M14").CopyPicture xlScreen, xlPicture
pptPres.Slides(2).Select
pptPres.Slides(2).Shapes.PasteSpecial DataType:=ppPasteEnhancedMetafile
Set Graphic2 = GetObject(, "Powerpoint.Application")
With Graphic2.ActiveWindow.Selection.ShapeRange
.Left = 0.39 * 72
.Top = 5 * 72
.Width = 5 * 72
.Height = 2 * 72
End With
pptPres.SaveAs strPath & Range("company") & ".pptx"
pptPres.Close
pptApp.Quit
Set pptPres = Nothing
Set pptApp = Nothing
End Sub
As BigBen has suggested, you can refer to the desired shape by index. However, there's no need to invoke GetObject. Try...
Sheets("NEW").Range("A1:M14").CopyPicture xlScreen, xlPicture
With pptPres.Slides(2)
.Shapes.PasteSpecial DataType:=ppPasteEnhancedMetafile
With .Shapes(.Shapes.Count) 'refers to last pasted shape
.Left = 0.39 * 72
.Top = 5 * 72
.Width = 5 * 72
.Height = 2 * 72
End With
End With
Your code, though, can be re-written as follows...
'Force the explicit declaration of variables
Option Explicit
Sub ExceltoPP()
Dim pptApp As PowerPoint.Application
Dim pptPres As PowerPoint.Presentation
Dim strPath As String
Dim strPPTX As String
Dim pptCopy As String
strPath = "D:\"
strPPTX = "Test.pptx"
pptCopy = strPath & strPPTX
Set pptApp = New PowerPoint.Application
Set pptPres = pptApp.Presentations.Open(Filename:=pptCopy, untitled:=msoTrue)
Sheets("NEW").Range("Table").CopyPicture xlScreen, xlPicture
With pptPres.Slides(2)
.Shapes.PasteSpecial DataType:=ppPasteEnhancedMetafile
With .Shapes(.Shapes.Count) 'refers to last pasted shape
.Left = 0.39 * 72
.Top = 2 * 72
.Width = 5 * 72
.Height = 2 * 72
End With
End With
Sheets("NEW").Range("A1:M14").CopyPicture xlScreen, xlPicture
With pptPres.Slides(2)
.Shapes.PasteSpecial DataType:=ppPasteEnhancedMetafile
With .Shapes(.Shapes.Count) 'refers to last pasted shape
.Left = 0.39 * 72
.Top = 5 * 72
.Width = 5 * 72
.Height = 2 * 72
End With
End With
pptPres.SaveAs strPath & Range("company").Value & ".pptx"
pptPres.Close
pptApp.Quit
Set pptPres = Nothing
Set pptApp = Nothing
End Sub
I am trying to copy an Excel chart to a specific placeholder in Powerpoint. I have named the placeholder using the following code
Sub NameShape()
Dim Name$
On Error GoTo AbortNameShape
If ActiveWindow.Selection.ShapeRange.Count = 0 Then
MsgBox "No Shapes Selected"
Exit Sub
End If
Name$ = ActiveWindow.Selection.ShapeRange(1).Name
Name$ = InputBox$("Give this shape a name", "Shape Name", Name$)
If Name$ <> "" Then
ActiveWindow.Selection.ShapeRange(1).Name = Name$
End If
Exit Sub
AbortNameShape:
MsgBox Err.Description
End Sub
In Excel I have come as far as this:
Sub CreateNewReport()
Dim pptApp As PowerPoint.Application
Dim pptPres As PowerPoint.Presentation
Dim pptSlide As PowerPoint.Slide
Dim pptShape As PowerPoint.Shape
Dim w!, h!, t!, l!
Dim Chart As Chart
Set pptApp = CreateObject("PowerPoint.Application")
pptApp.Visible = msoTrue
Set pptPres = pptApp.Presentations.Open("C:\Users\...\Report.pptm")
Set Chart = Worksheets("Analysts").ChartObjects("Chart 2")
Set PPSlide = pptPres.Slides(4)
'PPSlide.Shapes("Analyst.Forecasts").Copy
Set pptShape = pptPres.Slides(4).Shapes(4)
With pptShape
w = .Width
h = .Height
l = .Left
t = .Top
End With
pptShape.Parent.Paste
With Selection
.Width = w
.Height = h
.Left = l
.Top = t
End With
ppt.Shape.Delete
End Sub
Does anyone know how to take it from here? I can't quite figure out how to define the chart I want to copy and how to paste & replace the shep in Powerpoint. Ideally I would like to replace it with the metafile of the chart, but a picture is ok as well.
Thank you very much for your help!
i use this code to make ppt from Excel and paste in placeHolder;
Nr = 2
'Verifique os graficos nos arquivos
For Each Grf In E.ActiveSheet.ChartObjects
Grf.Copy
Sld.Shapes.Placeholders(Nr).Select msoCTrue
P.ActivePresentation.Windows(1).View.PasteSpecial (ppPasteMetafilePicture)
Nr = Nr + 1
Next Grf
End If