I've cobbled together a VBA script (I'm no expert, but thanks to the kind folks around here, I've been able to get something together and mostly working) to copy from multiple excel sheets into a powerpoint file (used a template, as you will see from the code.
Sub ATestPPTReport()
Dim PPApp As PowerPoint.Application
Dim PPSlide As PowerPoint.Slide
Dim PPPres As PowerPoint.Presentation
Set PPApp = CreateObject("Powerpoint.Application")
Dim SlideNum As Integer
Dim PPShape As PowerPoint.Shape
Set XLApp = GetObject(, "Excel.Application")
''define input Powerpoint template
Dim strPresPath As String, strExcelFilePath As String, strNewPresPath As String
''# Change "strPresPath" with full path of the Powerpoint template
strPresPath = "C:\template.ppt"
''# Change "strNewPresPath" to where you want to save the new Presentation to be created
strNewPresPath = "C:\macro_output-" & Format(Date, "dd-mmm-yyyy") & ".ppt"
Set PPPres = PPApp.Presentations.Open(strPresPath)
PPPres.Application.Activate
PPApp.Visible = True
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
''define destination slide
SlideNum = 1
PPPres.Slides(SlideNum).Select
Set PPShape = PPPres.Slides(SlideNum).Shapes("slide1box")
Set PPSlide = PPPres.Slides(PPApp.ActiveWindow.Selection.SlideRange.SlideIndex)
''define source sheet
Sheets("Info1").Activate
'copy/paste from
XLApp.Range("Info1Block").Copy
PPSlide.Shapes.PasteSpecial DataType:=ppPasteOLEObject, Link:=msoFalse
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
''define destination slide
SlideNum = 2
PPPres.Slides(SlideNum).Select
' Set PPShape = PPPres.Slides(SlideNum).Shapes("slide2box")
Set PPSlide = PPPres.Slides(PPApp.ActiveWindow.Selection.SlideRange.SlideIndex)
''define source sheet
Sheets("Info2").Activate
'copy/paste from
XLApp.Range("Info2Block").Copy
PPSlide.Shapes.PasteSpecial DataType:=ppPasteOLEObject, Link:=msoFalse
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Close presentation
PPPres.SaveAs strNewPresPath
'PPPres.Close
'Quit PowerPoint
'PPApp.Quit
' MsgBox "Presentation Created", vbOKOnly + vbInformation
' Clean up
Set PPSlide = Nothing
Set PPPres = Nothing
Set PPApp = Nothing
End Sub
My problem is: how do I resize/reposition the object once it's been pasted?
The function "PasteSpecial" returns a shape object, which you can use to resize or reposition.
For example:
Dim ppShape as PowerPoint.Shape
set ppShape = PPSlide.Shapes.PasteSpecial(DataType:=ppPasteOLEObject, Link:=msoFalse)
Then you can use this shape object to resize it. For example:
ppShape.Height = xyz
ppShape.Top = abc
etc etc.
Hope this helps.
Vikas B
This has been working for me:
Set shp = myPresentation.Slides(x).Shapes.PasteSpecial(DataType:=2)
shp.Left = topLeft + 1
shp.Top = midTop + 1
shp.Width = midLeft - topLeft - 1
Note the variables are set locally to place the image where I want it in relation to the slide. You can easily replace with integers.
It also works for DataType:=10 items as well
Related
I cant figure out how to incorporate my template into my actual code in VBA so that my sheets will build in the desired template and slides.
I have built the slides in a new blank powerpoint slides but cant figure out how to do it with template yet.
Sub LCTAKT_Macro()
'Declare variables
Dim PP As PowerPoint.Application
Dim PPPres As PowerPoint.Presentation
Dim PPSlide1 As PowerPoint.Slide
Dim PPSlide2 As PowerPoint.Slide
Dim PPSlide3 As PowerPoint.Slide
Dim PPSlide4 As PowerPoint.Slide
Dim PPSlide5 As PowerPoint.Slide
Dim PPSlide6 As PowerPoint.Slide
Dim PPSlide7 As PowerPoint.Slide
Dim SlideTitle As String
Dim objPPT As Object
'Open PowerPoint and create new presentation
Set objPPT = CreateObject("PowerPoint.Application")
objPPT.Visible = True
Set PP = New PowerPoint.Application
Set PPPres = PP.Presentations.Add
PP.Visible = True
objPPT.Presentations.Open ""
'-------------------------------------------------Station 42--------- ------------------------------------------------
'Add new slide as slide 2 and set focus to it
Set PPSlide1 = PPPres.Slides.Add(1, ppLayoutTitleOnly)
PPSlide1.Select
'Copy the range as a picture
Sheets("").Range("A1:W59").CopyPicture _
Appearance:=xlScreen, Format:=xlPicture
'Paste the picture and adjust its position
PPSlide1.Shapes.Paste.Select
PP.ActiveWindow.Selection.ShapeRange.Align msoAlignCenters, True
PP.ActiveWindow.Selection.ShapeRange.Align msoAlignMiddles, True
'Add the title to the slide
SlideTitle = ""
PPSlide1.Shapes.Title.TextFrame.TextRange.Text = SlideTitle
'Position pasted chart
PP.ActiveWindow.Selection.ShapeRange.Left = 200
PP.ActiveWindow.Selection.ShapeRange.Top = 130
PP.ActiveWindow.Selection.ShapeRange.Height = 523
PP.ActiveWindow.Selection.ShapeRange.Width = 554
I expect the template to be incorporated in the slides while still building the necessary data snippets to it.
Assuming Office 2013 or better, try this:
TemplateName$ = "C:\Users\YourActualUserName\Documents\Custom Office Templates\YourActualTemplateName.potx"
Set PPPres = PP.Presentations.Open(TemplateName$, False, True, True)
I have a chart range copied from excel. Now I want to paste it as picture in slide 5 of active presentation, but it is giving me below error.
"Shapes(unknown member):Invalid request.Clipboard is empty or contains data which may not be pasted here."
Please help, code below.
Sub UpdateCharts()
Dim oPP As PowerPoint.Slide
Dim shp As PowerPoint.shape
ActivePresentation.Slides(5).Shapes.Paste
End Sub
Try the code below (explanation inside the code comments):
Option Explicit
'=====================================================================
' This sub exports a range from Excel to PowerPoint,
' pastes it, and later on modifies it's position and size (if needed)
' The code works using Late-Binding, so there's no need
' to add References to the VB Project
'=====================================================================
Sub UpdateCharts()
Dim ppApp As Object
Dim ppPres As Object
Dim ppSlide As Object
Dim ppShape As Object
' check if PowerPoint application is Open
On Error Resume Next
Set ppApp = GetObject(, "PowerPoint.Application")
On Error GoTo 0
If ppApp Is Nothing Then
MsgBox "PowerPoint Application is not open", vbCritical
Exit Sub
End If
' set the Active Presentation
Set ppPres = ppApp.ActivePresentation
' set the Slide
Set ppSlide = ppPres.Slides(5)
' --- copy the Chart's Range (from Excel) ---
' <-- put your copy section here, right before the Paste
'With Worksheets("toPPT")
' .Range("F6:J7").Copy
'End With
' --- Paste to PowerPoint and modify properties (if needed) ---
Set ppShape = ppSlide.Shapes.PasteSpecial(3, msoFalse) ' 3 = ppPasteMetafilePicture
' modify properties of the pasted Chart (if needed)
With ppShape
.Left = 535
.Top = 86
End With
Application.CutCopyMode = False
ppPres.Save
Set ppSlide = Nothing
Set ppPres = Nothing
Set ppApp = Nothing
End Sub
Try this:
mySlide.Shapes.PasteSpecial DataType:=2 '2 = ppPasteEnhancedMetafile
Set myShape = mySlide.Shapes(mySlide.Shapes.(5))
I have the code below which I found online to copy paste a tble from excel to powerpoint. After pasting the table into the slide, it fails on PPSlide.Shapes(1).Select with a Run-time error '-2147188160 (80048240)': Shape.Select : Invalide request. To select a shape, its view must be active.
I've been searching and trying different things but can't seem to figure it out.. I thought after the paste that the table would be active and the code would jsut continue but it doesn't unless I activate/select the table in the slide and then click Run. Any help is appreciated. Thanks.
Dim pp As Object
Dim PPPres As Object
Dim PPSlide As Object
Dim Rng As Range
DestinationPPT = "C:\Users\username\Desktop\Data_Display.pptx"
Set pp = CreateObject("PowerPoint.Application")
Set PPPres = pp.Presentations.Open(DestinationPPT)
pp.Visible = True
Set Rng = ActiveSheet.Range("CA1:CJ" & Count + 1)
Rng.Copy
SlideCount = PPPres.Slides.Count
Set PPSlide = PPPres.Slides.Add(SlideCount, 12)
pp.ActivePresentation.Application.CommandBars.ExecuteMso ("PasteSourceFormatting")
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
Set PPSlide = Nothing
Set PPPres = Nothing
Set pp = Nothing
Try the code below:
Set pp = CreateObject("PowerPoint.Application")
Set ppPres = pp.Presentations.Open(DestinationPPT)
pp.Visible = True
' first set the Slide and select it
SlideCount = ppPres.Slides.Count
Set ppSlide = ppPres.Slides.Add(SlideCount, 12)
ppSlide.Select
' have the Copy part right beofre youe Paste it to PowerPoint
Set Rng = ActiveSheet.Range("CA1:CJ" & Count + 1)
Rng.Copy
pp.ActivePresentation.Application.CommandBars.ExecuteMso ("PasteSourceFormatting")
Dim myShape As Object
' set up the Pasted shape to an object
Set myShape = ppSlide.Shapes(ppSlide.Shapes.Count)
With myShape
' set-up the shape properties
End With
I'm an amateur coder. I'm trying to put something together to transfer all charts in an excel file to different slides on a powerpoint. I've tested several modules online (some from here as well). I've found this one below to be the most comprehensive for me so far. I have 3 graphs on a worksheet and for some reason I can't figure out, the code only copies one graph (first created), makes new slide and sticks it on that second slide. No idea what's going on, any help would be appreciated:
Sub ChartsAndTitlesToPresentation()
' Set a VBE reference to Microsoft PowerPoint Object Library
Dim PPApp As PowerPoint.Application
Dim PPPres As PowerPoint.Presentation
Dim PPSlide As PowerPoint.Slide
Dim PresentationFileName As Variant
Dim SlideCount As Long
Dim iCht As Integer
Dim sTitle As String
' Reference existing instance of PowerPoint
Set PPApp = GetObject(, "Powerpoint.Application")
' Reference active presentation
Set PPPres = PPApp.ActivePresentation
PPApp.ActiveWindow.ViewType = ppViewSlide
For iCht = 1 To ActiveSheet.ChartObjects.Count
With ActiveSheet.ChartObjects(iCht).Chart
' get chart title
If .HasTitle Then
sTitle = .ChartTitle.Text
Else
sTitle = ""
End If
' remove title (or it will be redundant)
.HasTitle = False
' copy chart as a picture
.CopyPicture _
Appearance:=xlScreen, Size:=xlScreen, Format:=xlPicture
' restore title
If Len(sTitle) > 0 Then
.HasTitle = True
.ChartTitle.Text = sTitle
End If
End With
' Add a new slide and paste in the chart
SlideCount = PPPres.Slides.Count
Set PPSlide = PPPres.Slides.Add(SlideCount + 1, ppLayoutTitleOnly)
PPApp.ActiveWindow.View.GotoSlide PPSlide.SlideIndex
With PPSlide
' paste and select the chart picture
.Shapes.Paste.Select
' align the chart
PPApp.ActiveWindow.Selection.ShapeRange.Align msoAlignCenters, True
PPApp.ActiveWindow.Selection.ShapeRange.Align msoAlignMiddles, True
.Shapes.Placeholders(1).TextFrame.TextRange.Text = sTitle
End With
Next
' Clean up
Set PPSlide = Nothing
Set PPPres = Nothing
Set PPApp = Nothing
End Sub
I am getting following error while pasting a slide in PowerPoint in the following line:
PPApp.ActiveWindow.View.PasteSpecial ppPasteOLEObject, msoFalse
Run-time error -2147188160 (80048240):View (unknown member) : Invalid request. The specified data type is Unavailable
I have run this code multiple times and it was running fine before.
Also, once the object/chart is copying; I am switching to PowerPoint to see if I can paste.
I can paste with all the options (As picture, As Embedded Image, etc.).
Here is the full code till I am getting error as it was not coming in comment section
Here is the code : Till the line where I get error
Sub export_to_ppt()
Set objExcel = CreateObject("Excel.Application")
'Keep the Importing master sheet address here:
Set objWorkbook = objExcel.Workbooks.Open("d:\Documents and Settings \Export to ppt.xlsm")
'Keep all the worksheets which you want to import from here:
Path = "D:\Office Documents\2013\ Latest Xcel\"
Filename = Dir(Path & "*.xlsm")
Do While Filename <> ""
Workbooks.Open Filename:=Path & Filename, ReadOnly:=True
Dim sht As Workbooks
Set Sheet = Workbooks(Filename).Sheets("Issues Concern")
Sheet.Copy After:=ThisWorkbook.Sheets(1)
Set Sheet = Workbooks(Filename).Sheets("Key Initiatives Update")
Sheet.Copy After:=ThisWorkbook.Sheets(1)
Set Sheet = Workbooks(Filename).Sheets("Solution Update")
Sheet.Copy After:=ThisWorkbook.Sheets(1)
Set Sheet = Workbooks(Filename).Sheets("Overall Practice Status")
Sheet.Copy After:=ThisWorkbook.Sheets(1)
Set Sheet = Workbooks(Filename).Sheets("Practice Financials")
Sheet.Copy After:=ThisWorkbook.Sheets(1)
Workbooks(Filename).Close
Filename = Dir()
Loop
Dim PPApp As PowerPoint.Application
Dim PPPres As PowerPoint.Presentation
Dim PPSlide As PowerPoint.Slide
Dim SlideCount As Integer
Dim shptbl As Table
Dim oShape As PowerPoint.Shape
Dim SelectRange As Range
Dim SelectCell As Range
Set PPApp = CreateObject("PowerPoint.Application")
PPApp.Visible = msoTrue
'opening an existing presentation
Filename = "D:\Office Documents\Presentation1.pptx"
Set PPPres = PPApp.Presentations.Open(Filename)
Dim s As String
Dim i As Integer
i = 2
Line3:
MsgBox (ActiveSheet.Name)
If ActiveSheet.Name Like ("*Solution Update*") Then
GoTo Line1
ElseIf ActiveSheet.Name Like ("*Key Initatives Update*") Then
GoTo Line4
ElseIf ActiveSheet.Name Like ("*Issues Concern*") Then
GoTo Line13
End If
Set PPSlide = PPPres.Slides.Add(SlideCount + 1, ppLayoutTitleOnly)
PPSlide.Shapes(1).TextFrame.TextRange.Text = "Practice Financials - " & Sheets(i).Range("AH1").Value & " "
'PPSlide.Shapes(1).TextFrame.TextRange.Text = Sheets(1).Range("B1").Value
'format header
With PPSlide.Shapes(1).TextFrame.TextRange.Characters
.Font.Size = 24
.Font.Name = "Arial Heading"
'.Font.Color = vbBlue
End With
Range("A1:K7").Select
Selection.Copy
PPApp.ActiveWindow.View.GotoSlide PPSlide.SlideIndex ' activate the slide no
'PPApp.Activate
PPApp.ActiveWindow.View.PasteSpecial ppPasteOLEObject, msoFalse ' paste using pastespecial method
'PPApp.ActiveWindow.View.PasteSpecial ppPasteEnhancedMetafile
'PPApp.ActiveWindow.View.PasteSpecial (ppPasteMetafilePicture)
I was having the same problem and it happened as I was trying to export from Excel to PowerPoint without the PowerPoint reference, using it as object. The tricky thing was that sometimes it worked, other times it won´t. So after some testing I found out that it depends on the state of the PowerPoint View, if it is showing Thumbnails or a normal Slide view.
To fix it, set the ViewType as normal before pasting.
PPAP.ActiveWindow.ViewType = ppViewNormal
or
PPAP.ActiveWindow.ViewType = 9
PPAP stands for power point application object.
Further to my comments above, this works for me. Let's say your sheet1 looks like this
Paste this code in a module.
Option Explicit
Sub Sample()
Dim PPApp As PowerPoint.Application
Dim PPPres As PowerPoint.Presentation
Dim PPSlide As PowerPoint.Slide
Dim SlideCount As Long
Dim ws As Worksheet
Dim rng As Range
Dim Filename As String
Set ws = ThisWorkbook.Sheets("Sheet1")
Set rng = ws.Range("A1:K7")
Set PPApp = CreateObject("PowerPoint.Application")
PPApp.Visible = msoTrue
'opening an existing presentation
Filename = "C:\Presentation1.pptx"
Set PPPres = PPApp.Presentations.Open(Filename)
SlideCount = PPPres.Slides.count
Set PPSlide = PPPres.Slides.Add(SlideCount + 1, ppLayoutTitleOnly)
With PPSlide.Shapes(1).TextFrame.TextRange
.Text = "Practice Financials - " & _
ws.Range("AH1").Value & " "
With .Characters.Font
.Size = 24
.Name = "Arial Heading"
End With
End With
rng.Copy
DoEvents
PPSlide.Shapes.PasteSpecial DataType:=ppPasteOLEObject, Link:=msoFalse
End Sub
OUTPUT