Creating linked pictures in powerpoint from excel ranges

[Rune PS]

Im looking for a way to take ranges in excel turn them into linked pictures in a power point presentation. I currently got most of it down, by combining a few diffrent codes i found, except i cannot get the pictures to link to the ranges, which sadly is a must.

My current code:

Sub PasteMultipleSlides_testing_link()
'PURPOSE: Copy Excel Ranges and Paste them into the Active PowerPoint presentation slides
'SOURCE: www.TheSpreadsheetGuru.com
Dim myPresentation As Object
Dim mySlide As Object
Dim PowerPointApp As Object
Dim shp As Object
Dim MySlideArray As Variant
Dim MyRangeArray As Variant
Dim x As Long
'Create an Instance of PowerPoint
On Error Resume Next

'Is PowerPoint already opened?
Set PowerPointApp = GetObject(class:="PowerPoint.Application")

'Clear the error between errors
Err.Clear
'If PowerPoint is not already open then Exit
If PowerPointApp Is Nothing Then
MsgBox "PowerPoint Presentation is not open, aborting."
Exit Sub
End If

'Handle if the PowerPoint Application is not found
If Err.Number = 429 Then
MsgBox "PowerPoint could not be found, aborting."
Exit Sub
End If
On Error GoTo 0

'Make PowerPoint Visible and Active
PowerPointApp.ActiveWindow.Panes(2).Activate

'Create a New Presentation
Set myPresentation = PowerPointApp.ActivePresentation
'List of PPT Slides to Paste to
MySlideArray = Array(4, 6, 8)
'List of Excel Ranges to Copy from
MyRangeArray = Array(Sheet1.Range("C4:F11"), Sheet3.Range("C4:F11"), Sheet5.Range("C4:F11"))
'Loop through Array data
For x = LBound(MySlideArray) To UBound(MySlideArray)
'Copy Excel Range
MyRangeArray(x).Copy

'Paste to PowerPoint
Set shp = myPresentation.Slides(MySlideArray(x)).Shapes.PasteSpecial(DataType:=2)
'Position object
With myPresentation
shp.LockAspectRatio = msoFalse
shp.Left = 133
shp.Top = 177
shp.Height = 200
shp.Width = 300
shp.LockAspectRatio = msoTrue
End With

Next x
'Transfer Complete
Application.CutCopyMode = False
ThisWorkbook.Activate
End Sub

Theres some extra code in there, which is to adjust the size, positioning, and slides for the objects, which is needed as each range needs to go into a specific slide, in a specific location.

Any way to get the pictures to also become linked to the ranges, such that if i change the excel range, the picture changes aswell? I have managed to get this working by copying it manually, but i cannot get VBA to do it automaticly, and sadly i cannot record a macro where i take action between excel and powerpoint. Note that ideally, it should work without me having to start by selecting the object i wanna link (saw alot of guides that suggested this method), as i need to create a larger number of linked pictures.

thanks in advance!

 

[Rune PS]

Just gonna casually bump this.
Also just to clarify, as i think i may have written it poorly. All i need added to the code is for it to also have the pictures become linked to the excel sheets, so the data updates automaticly.

 

[Rune PS]

Gonna try bumping this one last time
Any help would be appreciated!

 

[areed1192]

So, unfortunately, you can't do linked pictures in PowerPoint, however, you can have linked Excel Objects that you can embed into PowerPoint. Hopefully, you don't mind me readjusting your code but I think we could write this a little bit more concisely but still achieve most of the same goals.

Really the only thing you need to change is the pasting section:

'Change this
[COLOR=#574123]Set shp = myPresentation.Slides(MySlideArray(x)).Shapes.PasteSpecial(DataType:=2)

[/COLOR]'To this
[COLOR=#574123]Set shp = myPresentation.Slides(MySlideArray(x)).Shapes.PasteSpecial(DataType:=0)[/COLOR]

In this case "0" is referring to an OLEObject. As I mentioned before, there is no "Linked Picture" in PowerPoint, but we can have linked OLEObjects so I adjusted the code to reflect that

Now for the actual exporting of multiple ranges, I would write this code to use early-binding if you don't plan on sharing the code. The code you presented was written using the late-binding method and we only should use that if we are planning to share it with someone else and we are not sure what version of office they are on.

With early-binding, we can leverage Intellisense which will make our lives so much easier

Sub ExportMultipleRangesToPowerPoint()
    
    'Declare PowerPoint Variables
    Dim PPTApp As PowerPoint.Application
    Dim PPTPres As PowerPoint.Presentation
    Dim PPTSlide As PowerPoint.Slide
    
    'Declare Excel Variables
    Dim ExcRng As Range
    Dim RngArray As Variant
    Dim SldArray As Variant
    
    'Create a new instance of PowerPoint
    Set PPTApp = New PowerPoint.Application
        PPTApp.Visible = True
        
    'Create a new presentation
    Set PPTPres = PPTApp.Presentations.Add
    
    'Array that houses all of our ranges that we want to export
    RngArray = Array([COLOR=#574123]Sheet1.Range("C4:F11"), Sheet3.Range("C4:F11"), Sheet5.Range("C4:F11")[/COLOR])
    
    'Define the Slide Array
    [COLOR=#574123]SldArray = Array(4, 6, 8)
[/COLOR]
    'Loop through our array, copy the excel range, create a new slide, and paste the range in the slide
    For x = LBound(RngArray) To UBound(RngArray)
    
        'Create a reference to the range we want to export
        Set ExcRng = RngArray(x)
        
        'Copy the excel range
        ExcRng.Copy
        
        'Create a new slide
        Set PPTSlide = PPTPres.Slides.Add([COLOR=#574123]SldArray(x)[/COLOR], ppLayoutBlank)
        
        'Paste the range in the slide as a linked OLEObject[B] THIS IS THE PART YOU NEEDED[/B]
        PPTSlide.Shapes.PasteSpecial DataType:=ppPasteOLEObject, Link:=msoTrue

        With PPTApp.ActiveWindow.Selection.ShapeRange
               .LockAspectRatio = msoFalse

[COLOR=#574123]               .Left = 133[/COLOR]
[COLOR=#574123]               .Top = 177   [/COLOR]
[COLOR=#574123]               .Height = 200[/COLOR]
[COLOR=#574123]               .Width = 300
               [/COLOR].LockAspectRatio = msoTrue
        End With

        
    Next x
    
[COLOR=#574123]Application.CutCopyMode = False
[/COLOR]
End Sub

Now if this code is a little confusing to you or you need some clarification on how portions of it works I provided a link to my YouTube video that goes over it.

https://youtu.be/oK-pYnrmu9I

FULL DISCLOSURE THIS IS MY PERSONAL YOUTUBE ACCOUNT

Hopefully, this code helps you out but if you still have any questions don't hesitate to reach back out. Good luck

 

[Phoenixmoto]

Im looking for a way to take ranges in excel turn them into linked pictures in a power point presentation. I currently got most of it down, by combining a few diffrent codes i found, except i cannot get the pictures to link to the ranges, which sadly is a must.

My current code:

Sub PasteMultipleSlides_testing_link()
'PURPOSE: Copy Excel Ranges and Paste them into the Active PowerPoint presentation slides
'SOURCE: www.TheSpreadsheetGuru.com
Dim myPresentation As Object
Dim mySlide As Object
Dim PowerPointApp As Object
Dim shp As Object
Dim MySlideArray As Variant
Dim MyRangeArray As Variant
Dim x As Long
'Create an Instance of PowerPoint
On Error Resume Next

'Is PowerPoint already opened?
Set PowerPointApp = GetObject(class:="PowerPoint.Application")

'Clear the error between errors
Err.Clear
'If PowerPoint is not already open then Exit
If PowerPointApp Is Nothing Then
MsgBox "PowerPoint Presentation is not open, aborting."
Exit Sub
End If

'Handle if the PowerPoint Application is not found
If Err.Number = 429 Then
MsgBox "PowerPoint could not be found, aborting."
Exit Sub
End If
On Error GoTo 0

'Make PowerPoint Visible and Active
PowerPointApp.ActiveWindow.Panes(2).Activate

'Create a New Presentation
Set myPresentation = PowerPointApp.ActivePresentation
'List of PPT Slides to Paste to
MySlideArray = Array(4, 6, 8)
'List of Excel Ranges to Copy from
MyRangeArray = Array(Sheet1.Range("C4:F11"), Sheet3.Range("C4:F11"), Sheet5.Range("C4:F11"))
'Loop through Array data
For x = LBound(MySlideArray) To UBound(MySlideArray)
'Copy Excel Range
MyRangeArray(x).Copy

'Paste to PowerPoint
Set shp = myPresentation.Slides(MySlideArray(x)).Shapes.PasteSpecial(DataType:=2)
'Position object
With myPresentation
shp.LockAspectRatio = msoFalse
shp.Left = 133
shp.Top = 177
shp.Height = 200
shp.Width = 300
shp.LockAspectRatio = msoTrue
End With

Next x
'Transfer Complete
Application.CutCopyMode = False
ThisWorkbook.Activate
End Sub

Theres some extra code in there, which is to adjust the size, positioning, and slides for the objects, which is needed as each range needs to go into a specific slide, in a specific location.

Any way to get the pictures to also become linked to the ranges, such that if i change the excel range, the picture changes aswell? I have managed to get this working by copying it manually, but i cannot get VBA to do it automaticly, and sadly i cannot record a macro where i take action between excel and powerpoint. Note that ideally, it should work without me having to start by selecting the object i wanna link (saw alot of guides that suggested this method), as i need to create a larger number of linked pictures.

thanks in advance!

Im looking for a way to take ranges in excel turn them into linked pictures in a power point presentation. I currently got most of it down, by combining a few diffrent codes i found, except i cannot get the pictures to link to the ranges, which sadly is a must.

My current code:

Sub PasteMultipleSlides_testing_link()
'PURPOSE: Copy Excel Ranges and Paste them into the Active PowerPoint presentation slides
'SOURCE: www.TheSpreadsheetGuru.com
Dim myPresentation As Object
Dim mySlide As Object
Dim PowerPointApp As Object
Dim shp As Object
Dim MySlideArray As Variant
Dim MyRangeArray As Variant
Dim x As Long
'Create an Instance of PowerPoint
On Error Resume Next

'Is PowerPoint already opened?
Set PowerPointApp = GetObject(class:="PowerPoint.Application")

'Clear the error between errors
Err.Clear
'If PowerPoint is not already open then Exit
If PowerPointApp Is Nothing Then
MsgBox "PowerPoint Presentation is not open, aborting."
Exit Sub
End If

'Handle if the PowerPoint Application is not found
If Err.Number = 429 Then
MsgBox "PowerPoint could not be found, aborting."
Exit Sub
End If
On Error GoTo 0

'Make PowerPoint Visible and Active
PowerPointApp.ActiveWindow.Panes(2).Activate

'Create a New Presentation
Set myPresentation = PowerPointApp.ActivePresentation
'List of PPT Slides to Paste to
MySlideArray = Array(4, 6, 8)
'List of Excel Ranges to Copy from
MyRangeArray = Array(Sheet1.Range("C4:F11"), Sheet3.Range("C4:F11"), Sheet5.Range("C4:F11"))
'Loop through Array data
For x = LBound(MySlideArray) To UBound(MySlideArray)
'Copy Excel Range
MyRangeArray(x).Copy

'Paste to PowerPoint
Set shp = myPresentation.Slides(MySlideArray(x)).Shapes.PasteSpecial(DataType:=2)
'Position object
With myPresentation
shp.LockAspectRatio = msoFalse
shp.Left = 133
shp.Top = 177
shp.Height = 200
shp.Width = 300
shp.LockAspectRatio = msoTrue
End With

Next x
'Transfer Complete
Application.CutCopyMode = False
ThisWorkbook.Activate
End Sub

Theres some extra code in there, which is to adjust the size, positioning, and slides for the objects, which is needed as each range needs to go into a specific slide, in a specific location.

Any way to get the pictures to also become linked to the ranges, such that if i change the excel range, the picture changes aswell? I have managed to get this working by copying it manually, but i cannot get VBA to do it automaticly, and sadly i cannot record a macro where i take action between excel and powerpoint. Note that ideally, it should work without me having to start by selecting the object i wanna link (saw alot of guides that suggested this method), as i need to create a larger number of linked pictures.

thanks in advance!

My problem is with my code which is similar to this one when I paste linked table from excel 2007 or 2010 to PowerPoint 2007 and then try to set lockaspectratio to false it works only for very next step i.e. either setting width or height but then it automatically Sets to true.
How to set lockaspectratio to false permanently for linked object in PowerPoint 2007.
Please reply with some valid code so that I can change width or height independantly i.e. set lockaspectratio to false permanently.