I am attempting to capture a screenshot from an application I've connected to with VBA in Excel. I want to take a screenshot and paste it into PowerPoint. However, I want to have each screen shot on a new slide.
Dim Pptapp As New PowerPoint.Application
Set pres = Pptapp.Presentations.Add
Dim slidev As PowerPoint.Slide
'(take Screenshot, Don't need code help here)
'need help creating new slide
'need help pasting screenshot on new slide
'I want this to be able to loop through the below items
do until (the end of time)
Screenshot
new slide
paste on new slide
loop
Dim Pptapp As New PowerPoint.Application
Set pres = Pptapp.Presentations.Add
Dim slidev As PowerPoint.Slide
PrintTheScreen ' function added else where
Set slidev = pres.Slides.Add(1, PowerPoint.PpSlideLayout.ppLayoutBlank)
slidev.Select
PasteTheScreen ' function added else where
I needed to do the .Select function to make sure the slide was getting the paste.
Dim Pptapp As New PowerPoint.Application
Set pres = Pptapp.Presentations.Add
Dim slidev As PowerPoint.Slide
PrintTheScreen ' function added else where
Set slidev = pres.Slides.Add(1, PowerPoint.PpSlideLayout.ppLayoutBlank)
slidev.Select
PasteTheScreen ' function added else where
I needed to do the .select function to make sure the slide was getting the paste.
Related
I read the object browser and its signature about Slides.AddSlide method.
Dim pptSlide As Slide
Set pptSlide = ActivePresentation.Slides.AddSlide(ActivePresentation.Slides.Count + 1, pCustomLayout:=ppLayoutCustom)
However, when I run this in my Macro, I get the error:
ppLayoutCustom gets highlighted and "Compile error: Type mismatch".
What am I doing wrong, please?
Blank slides are a preset layout, not a custom one. Here's how to add a blank slide:
Public Sub BlankSlide()
Dim oSlide As Slide
Set oSlide = ActivePresentation.Slides.Add(Index:=2, Layout:=ppLayoutBlank)
End Sub
You don't show where you got ppLayoutCustom from.
https://learn.microsoft.com/en-us/office/vba/api/powerpoint.slides.addslide has this example code which you might be following?
Public Sub Add_Example()
Dim pptSlide As Slide
Dim pptLayout As CustomLayout
Set pptLayout = ActivePresentation.Slides(1).CustomLayout ' do this first
Set pptSlide = ActivePresentation.Slides.AddSlide(2, pptLayout)
End Sub
I am looking for VBA codes to create think cell chart from excel ranges.
All I found in the internet were VBA codes through which I can update a named thinkcell chart.
However I want the macro to create a new powerpoint and new thinkcell chart from my defined range.
Would that be possible?
Below is the code I found through which one can update Thinkcell chart, but not create a new thinkcell chart.
Sub UpdateThinkCellChart(Rng As Range, sChartName As String)
'Get the think-cell add-in object
Dim tcaddin As Object
Dim ppapp As Object
Dim pres As Object
Set tcaddin = Application.COMAddIns("thinkcell.addin").Object
'Set PowerPoint instance
'Set ppapp = New PowerPoint.Application
On Error Resume Next
Set ppapp = GetObject(, "Powerpoint.Application")
On Error GoTo 0
'Create PowerPoint presentation if none is open:
If ppapp Is Nothing Then
MsgBox "No PowerPoint presentation is open. Please open the relevant presentation and ensure that you have pre-assigned chart names to your ThinkCell charts"
Exit Sub
End If
'Dim pres As PowerPoint.Presentation
Set pres = ppapp.ActivePresentation
' The name sChartName must have been previously assigned to the chart using
' the control in the floating toolbar (left-click on the Think-Cell chart to see this)
' The final argument indicates whether the data range is transposed or not.
Call tcaddin.UpdateChart(pres, sChartName, Rng, False)
End Sub
Sub CopyToTC_ChartNo1()
Dim Rng As Range, sRange As String, sChartName As String
'Insert values:
sRange = "C21:F25"
sChartName = "ChartNo1"
Set Rng = ActiveSheet.Range(sRange)
Call UpdateThinkCellChart(Rng, sChartName)
End Sub
I currently am building a table in Excel through automation in PowerShell. This steps works great, the table ends up exactly as I like. I would now like to paste this in to a PowerPoint presentation.
The PowerPoint presentation is a template I have created, which is then filled in with other elements. I think I have every part cracked apart from this one.
I want to paste from the Excel file that is already open in the background. So far it is activated, and desired range selected. It is then pasted in to the PowerPoint window. However, it comes through as a grey table with none of the formatting.
Previously when putting together my template and manually testing the different components, the line below did the paste from Excel and it was perfect.
ActivePresentation.Application.CommandBars.ExecuteMso "PasteExcelTableSourceFormatting"
However, since moving to the automation (and interacting with different windows etc) it no longer works. Instead giving a "cannot create activex component" error.
Full code below:
Function CreateFLUTemplate(templateFile As String, PresPath As Variant, TalkingPointsDoc As Variant, LineOfBusiness As String, PolicyLink As String)
' Declare variables to be used
Dim PPApp As PowerPoint.Application
Dim PPPres As PowerPoint.Presentation
Dim WordApp As Word.Application
Dim PPFile As Object, WordDoc As Object
Dim TitleBox As PowerPoint.Shape, MetricsHeader As PowerPoint.Shape, MetricsTable As PowerPoint.Shape, PhishingHeader As PowerPoint.Shape, PhishingTable As PowerPoint.Shape
Dim PolicyHeader As PowerPoint.Shape, PolicyBox As PowerPoint.Shape, TalkingPointsHeader As PowerPoint.Shape, TalkingPointsBox As PowerPoint.Shape, shp As PowerPoint.Shape
Dim PPSlide As Slide
Dim WAIT As Double
Dim ShapeArray As Variant, LabelsArray As Variant, DateLabel As Variant
Dim i As Integer
' Open blank presentation file to be updated
Set PPApp = CreateObject("PowerPoint.Application")
PPApp.Visible = msoTrue
Set PPFile = PPApp.Presentations.Open(PresPath)
Set PPPres = PPApp.ActivePresentation
' Construct date that will be used in the header sections
DateLabel = Format(DateSerial(Year(Date), Month(Date), 0), "d mmmm yyyy")
' Set slide object so we can set our shape variables etc
Set PPSlide = PPPres.Slides(1)
' Copy finished Excel table
' Activate Spreadsheet with table to be copied
Windows(templateFile).Activate
Range("A1:E10").Copy
PPApp.Windows(1).Activate
' Paste Excel table in to PowerPoint
'ActivePresentation.Application.CommandBars.ExecuteMso "PasteExcelTableSourceFormatting"
'PPPres.Slides(1).Shapes.PasteSpecial(DataType:=ppPasteShape).Select
PPApp.ActivePresentation.Slides(1).Shapes.Paste
' Introduce delay to let paste action happen before moving on
WAIT = Timer
While Timer < WAIT + 0.5
DoEvents
Wend
' Take pasted table and save to object
If PPApp.ActiveWindow.Selection.Type = ppSelectionNone Then
MsgBox "Nothing is selected", vbExclamation
Else
For Each shp In PPApp.ActiveWindow.Selection.ShapeRange
Set MetricsTable = PPApp.ActivePresentation.Slides(1).Shapes(shp.Name)
Next shp
End If
' Reposition and resize pasted table.
With MetricsTable
.Left = 27
.Top = 108
.Width = 363
.Table.Columns(1).Width = 148
.Table.Columns(2).Width = 28
.Table.Columns(3).Width = 28
.Table.Columns(4).Width = 28
.Table.Columns(5).Width = 131
.Height = 227
End With
Managed to fix it, can't believe I didn't think to check the code for a very similar action that was already working! I should have been using:
PPPres.Application.CommandBars.ExecuteMso "PasteExcelTableSourceFormatting"
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
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