# VBA code to copy pictures from a workbook into a blank Powerpoint?



## ajjava (Dec 19, 2018)

...bit of the code, but not all of it. The excel file contains what appear to be charts, but they're really pictures. I want a macro to copy any picture on a visible worksheet into a PPT presentation. I have the code worked out to create a new, blank PPT and it does work to copy a few of the images to the PPT, but then it falls apart during the For Each section. I know enough to be dangerous but certainly am no expert. So, to recap:

* Start in excel workbook
* For each picture, on each visible worksheet, copy the picture and...
* Create a new powerpoint presentation
* Insert a new slide
* Paste each picture from the workbook onto a new slide
* Adjust the slide size/position

Here is my existing code (pieced together from various sources). Chart-specific lines have been commented out, since I'm not really working with charts (charts have been pasted into excel as pictures, via SAP/Biz Objects):


```
Public Sub TestCopyPastePic()
'Declare the needed variables
    Dim newPP As PowerPoint.Application
    Dim currentSlide As PowerPoint.Slide
    Dim XShape As Excel.Shape
    Dim ws As Worksheet
 'Check if PowerPoint is active
    On Error Resume Next
    Set newPP = GetObject(, "PowerPoint.Application")
    On Error GoTo 0
'Open PowerPoint if not active
    If newPP Is Nothing Then
        Set newPP = New PowerPoint.Application
    End If
'Create new presentation in PowerPoint
    If newPP.Presentations.Count = 0 Then
        newPP.Presentations.Add
    End If
'Display the PowerPoint presentation
    'newPowerPoint.Visible = True

'Locate Excel charts to paste into the new PowerPoint presentation
    
    For Each ws In ActiveWorkbook.Worksheets
    
        If ws.Visible Then
            For Each XShape In ActiveSheet.Shapes
            'Add a new slide in PowerPoint for each Excel chart
                newPP.ActivePresentation.Slides.Add newPP.ActivePresentation.Slides.Count + 1, ppLayoutText
                newPP.ActiveWindow.View.GotoSlide newPP.ActivePresentation.Slides.Count
                Set currentSlide = newPP.ActivePresentation.Slides(newPP.ActivePresentation.Slides.Count)
    
            'Copy each Excel chart and paste it into PowerPoint as an Metafile image
                XShape.Select
                Selection.Copy
                currentSlide.Shapes.PasteSpecial(DataType:=ppPasteMetafilePicture).Select
            'Copy and paste chart title as the slide title in PowerPoint
           ' currentSlide.Shapes(1).TextFrame.TextRange.Text = cht.Chart.ChartTitle.Text
    
            'Adjust the slide position for each chart slide in PowerPoint. Note that you can adjust the values to position the chart on the slide to your liking
                newPP.ActiveWindow.Selection.ShapeRange.Left = 25
                newPP.ActiveWindow.Selection.ShapeRange.Top = 150
                currentSlide.Shapes(2).Width = 250
                currentSlide.Shapes(2).Left = 500
            Next XShape
          Else
          'Next ws
          End If
    Next ws
AppActivate ("Microsoft PowerPoint")
Set currentSlide = Nothing
Set newPP = Nothing
End Sub
```


----------



## areed1192 (Dec 26, 2018)

*Re: VBA code to copy each picture from this workbook into a blank Powerpoint? I have a little...*

I rewrote some of the code to make it a little more concise. *First thing I did was create some more variables to house all the different PowerPoint objects*, this allows us to write the code more precisely and ensure that we are able to work that particular object. 

*I would take a look at the actual portion where we create an instance of PowerPoint,* when I was reading your post it sounds like you are wanting a create a new PowerPoint presentation. The way the code was written you were first testing if PowerPoint was opening and then if it was you were creating the presentation. If we don't assume it's open we can technically make it work with fewer lines, but I left it the way you had it. 

*From there we loop through each VISIBLE worksheet, then all the shapes on that worksheet.* I added a section that tests whether the shape is of the* Type picture *and if it is then it will copy it, otherwise, it will move on to the next shape.

Then we add a new slide, go to that slide, copy the chart, and paste it on the current slide we have selected.

Then we create a reference to the shape we just pasted, select it and then set the dimensions of that shape.

*If you would like to learn more about pasting objects because there are many different ways to paste in VBA I encourage you to watch some of my YouTube Videos. Full Disclosure these are my personal YouTube videos on my channel.

Pasting Charts From Excel To PowerPoint
https://youtu.be/DOaBtYMCCEM

Pasting Shapes in PowerPoint From Excel
https://youtu.be/cpwHL26Nxhc

Manipulating Shapes in PowerPoint
https://youtu.be/TyZ47qI0NkQ*


```
Public Sub TestCopyPastePic()

'Declare PowerPoint Variables
Dim PPTApp As PowerPoint.Application
Dim PPTSlide As PowerPoint.Slide
Dim PPTPres As PowerPoint.Presentation
Dim PPTShape As PowerPoint.Shape


'Declare Excel Variables
Dim ExcShape As Excel.Shape
Dim WrkSht As Worksheet


'Check if PowerPoint is active
On Error Resume Next
Set PPTApp = GetObject(, "PowerPoint.Application")
On Error GoTo 0

'Open PowerPoint if not active
If PPTApp Is Nothing Then
Set PPTApp = New PowerPoint.Application
End If
    
'Display the PowerPoint presentation
PPTApp.Visible = True

'Create new presentation in PowerPoint
If PPTApp.Presentations.Count = 0 Then
PPTApp.Presentations.Add
End If

'Create a reference to the Active Presentation
Set PPTPres = PPTApp.ActivePresentation
    
'Locate Excel charts to paste into the new PowerPoint presentation
For Each WrkSht In ActiveWorkbook.Worksheets
    
'If the Worksheet is visible then continue on.
If WrkSht.Visible Then
    
For Each ExcShape In ActiveSheet.Shapes
        
If ExcShape.Type = msoPicture Then
            
'Create a new slide
Set PPTSlide = PPTPres.Slides.Add(PPTPres.Slides.Count + 1, ppLayoutText)
               
'Go to the new slide
PPTApp.ActiveWindow.View.GotoSlide PPTPres.Slides.Count
               
'Copy the Shape
ExcShape.Copy
               
'Paste Shape in the slide.
PPTSlide.Shapes.PasteSpecial DataType:=ppPasteMetafilePicture
Set PPTShape = PPTSlide.Shapes(PPTSlide.Shapes.Count)
PPTShape.Select
       
'Set the dimensions of the shape.
With PPTApp.ActiveWindow.Selection.ShapeRange
.Left = 25
.Top = 150
.Width = 250
.Left = 500
End With
               
End If
            
Next ExcShape
        
End If
            
Next WrkSht

'Activate the PowerPoint App
PPTApp.Activate

'Memory clean up
Set PPTSlide = Nothing
Set PPTApp = Nothing
Set PPTShape = Nothing


End Sub
```


----------



## ajjava (Dec 26, 2018)

*Re: VBA code to copy each picture from this workbook into a blank Powerpoint? I have a little...*

Thank you SOOOOOO much for your code and reply. I can't wait to try it out, and this is the perfect day for that, since nobody else is working on this day-after-Christmas


----------



## ajjava (Dec 26, 2018)

*Re: VBA code to copy each picture from this workbook into a blank Powerpoint? I have a little...*

So, I've been playing with the code you provided, *areed1192.
*
I ran into an issue where the code just keeps looping through the very first worksheet, copy/pasting the pics from that one page over and over again (into separate, new slides in PPT). In my particular test workbook, there are 4 picture objects on the first worksheet. When your code finishes running, I end up with 48 PPT slides, with those 4 picture objects pasted over and over in succession. 

Any ideas on how to correct? 

Thanks!


----------



## ajjava (Dec 26, 2018)

*Re: VBA code to copy each picture from this workbook into a blank Powerpoint? I have a little...*



ajjava said:


> So, I've been playing with the code you provided, *areed1192.
> *
> I ran into an issue where the code just keeps looping through the very first worksheet, copy/pasting the pics from that one page over and over again (into separate, new slides in PPT). In my particular test workbook, there are 4 picture objects on the first worksheet. When your code finishes running, I end up with 48 PPT slides, with those 4 picture objects pasted over and over in succession.
> 
> ...



I figured out the missing piece of code that was causing the loop - this line needed to be added after "checking if the worksheet is visible":

WrkSht.Activate


----------



## areed1192 (Dec 26, 2018)

*Re: VBA code to copy each picture from this workbook into a blank Powerpoint? I have a little...*

Sorry, I must've missed that line but that was the correct fix. Glad to hear it's working though!


----------



## ajjava (Dec 27, 2018)

*Re: VBA code to copy each picture from this workbook into a blank Powerpoint? I have a little...*



areed1192 said:


> Sorry, I must've missed that line but that was the correct fix. Glad to hear it's working though!



What modification would I need to make to have TWO pics/objects per slide, before moving to the next object & new slide?


----------



## ajjava (Dec 27, 2018)

*Re: VBA code to copy each picture from this workbook into a blank Powerpoint? I have a little...*



ajjava said:


> What modification would I need to make to have TWO pics/objects per slide, before moving to the next object & new slide?



And I should also specify that I'd love to know how to position the two pics in a certain place on the slide, one on top of the other (Top pic = 210, 30  Bottom pic = 210, 282)


----------



## areed1192 (Dec 27, 2018)

*Re: VBA code to copy each picture from this workbook into a blank Powerpoint? I have a little...*



ajjava said:


> And I should also specify that I'd love to know how to position the two pics in a certain place on the slide, one on top of the other (Top pic = 210, 30 Bottom pic = 210, 282)



So for this one, all you need to know is that the top dimensions how far down from the top of the slide the shape is and the left dimension is how far in from the left the shape is on the slide.


----------



## areed1192 (Dec 27, 2018)

*Re: VBA code to copy each picture from this workbook into a blank Powerpoint? I have a little...*



ajjava said:


> What modification would I need to make to have TWO pics/objects per slide, before moving to the next object & new slide?



This is a little more complicated. Is it always two images on a slide? Is it only certain worksheets? All these questions and more have to be answered in order to build the script properly. However, in a general sense, we just need to specify the slide we want to work with so, for example, we can simply add this line of code after we add a new slide:


```
'Specify the slide we want to work with
Set PPTSlide = PPTPres.Slides(Index)
```

Where the index is the slide number in the presentation.


----------



## ajjava (Dec 19, 2018)

...bit of the code, but not all of it. The excel file contains what appear to be charts, but they're really pictures. I want a macro to copy any picture on a visible worksheet into a PPT presentation. I have the code worked out to create a new, blank PPT and it does work to copy a few of the images to the PPT, but then it falls apart during the For Each section. I know enough to be dangerous but certainly am no expert. So, to recap:

* Start in excel workbook
* For each picture, on each visible worksheet, copy the picture and...
* Create a new powerpoint presentation
* Insert a new slide
* Paste each picture from the workbook onto a new slide
* Adjust the slide size/position

Here is my existing code (pieced together from various sources). Chart-specific lines have been commented out, since I'm not really working with charts (charts have been pasted into excel as pictures, via SAP/Biz Objects):


```
Public Sub TestCopyPastePic()
'Declare the needed variables
    Dim newPP As PowerPoint.Application
    Dim currentSlide As PowerPoint.Slide
    Dim XShape As Excel.Shape
    Dim ws As Worksheet
 'Check if PowerPoint is active
    On Error Resume Next
    Set newPP = GetObject(, "PowerPoint.Application")
    On Error GoTo 0
'Open PowerPoint if not active
    If newPP Is Nothing Then
        Set newPP = New PowerPoint.Application
    End If
'Create new presentation in PowerPoint
    If newPP.Presentations.Count = 0 Then
        newPP.Presentations.Add
    End If
'Display the PowerPoint presentation
    'newPowerPoint.Visible = True

'Locate Excel charts to paste into the new PowerPoint presentation
    
    For Each ws In ActiveWorkbook.Worksheets
    
        If ws.Visible Then
            For Each XShape In ActiveSheet.Shapes
            'Add a new slide in PowerPoint for each Excel chart
                newPP.ActivePresentation.Slides.Add newPP.ActivePresentation.Slides.Count + 1, ppLayoutText
                newPP.ActiveWindow.View.GotoSlide newPP.ActivePresentation.Slides.Count
                Set currentSlide = newPP.ActivePresentation.Slides(newPP.ActivePresentation.Slides.Count)
    
            'Copy each Excel chart and paste it into PowerPoint as an Metafile image
                XShape.Select
                Selection.Copy
                currentSlide.Shapes.PasteSpecial(DataType:=ppPasteMetafilePicture).Select
            'Copy and paste chart title as the slide title in PowerPoint
           ' currentSlide.Shapes(1).TextFrame.TextRange.Text = cht.Chart.ChartTitle.Text
    
            'Adjust the slide position for each chart slide in PowerPoint. Note that you can adjust the values to position the chart on the slide to your liking
                newPP.ActiveWindow.Selection.ShapeRange.Left = 25
                newPP.ActiveWindow.Selection.ShapeRange.Top = 150
                currentSlide.Shapes(2).Width = 250
                currentSlide.Shapes(2).Left = 500
            Next XShape
          Else
          'Next ws
          End If
    Next ws
AppActivate ("Microsoft PowerPoint")
Set currentSlide = Nothing
Set newPP = Nothing
End Sub
```


----------



## ajjava (Dec 27, 2018)

*Re: VBA code to copy each picture from this workbook into a blank Powerpoint? I have a little...*



areed1192 said:


> This is a little more complicated. Is it always two images on a slide? Is it only certain worksheets? All these questions and more have to be answered in order to build the script properly. However, in a general sense, we just need to specify the slide we want to work with so, for example, we can simply add this line of code after we add a new slide:
> 
> 
> ```
> ...



Here is an overview of what I'm ultimately trying to do:
An Excel workbook will be generated from our ERP system (SAP/Business Objects)
It will contain a fixed number of worksheets
Each worksheet will contain 4 pictures (the pictures started their lives as Charts in BizObj, but are converted via export into pic format)
Each time a workbook is generated from our ERP (on-demand and by specific client), all of the contents in the workbook will need to be copy/pasted into a predefined PPT presentation _template_
Each slide should contain 2 pictures, positioned as I mentioned above (in inches, roughly 2.92/0.42 for the top pic and 2.92/3.92 for the bottom pic - 210/30 & 210/282 in points)

Whomever was in my role before me was able to build an INCREDIBLE series of VBA scripts that carried out all of the above, and more. But that script was working with _actual_ charts, not pictures. The process has now changed entirely and I'm trying to be the hero by coming up with a way to somewhat replicate what my predecessor created. (Sidebar: Of course, the change that was implemented has simplified some aspects of the process, while WAYYYYY over-complicated many others - whomever performed the cost/benefit analysis really dropped the ball, IMHO). Anyway, here is one of the scripts (from PPT), just so you can get a feel for the complexity:

```
Sub populateExecutiveSummary()
Dim pptApp As PowerPoint.Application
Dim PA_Presentation As PowerPoint.Presentation, ES_Presentation As PowerPoint.Presentation
Dim PA_slide As PowerPoint.Slide, ES_slide As PowerPoint.Slide
Dim PA_shape As PowerPoint.Shape, ES_Shape As PowerPoint.Shape
Dim SINGLE_TOP_ADJUST As Double, SINGLE_LEFT_ADJUST As Double, SINGLE_LEFT_ADJUST_narrow As Double
Dim DOUBLE_TOP_ADJUST As Double, DOUBLE_LEFT_ADJUST As Double, DOUBLE_Bottom_ADJUST As Double
Dim TITLE_TOP_ADJUST As Double, TITLE_LEFT_ADJUST As Double
Dim ES_SlideName As String, ES_SlideName_prev As String, ES_SlideName_send As String, ES_SlideCounter As Integer
Dim filePath As Variant
Dim wsCount As Integer
Dim I1 As Integer
Dim wsTagName As String
Dim wsNmbrOfGraphs As Integer
Dim SecondGraph As String
Dim wsWidth As Single
Dim wsShapename As String
Dim Title1Text As String
Dim SlideShapeCount As Integer
Dim wsGraphType As String
SINGLE_TOP_ADJUST = excel.Application.InchesToPoints(1.13)
SINGLE_LEFT_ADJUST = excel.Application.InchesToPoints(1.08)
SINGLE_LEFT_ADJUST_narrow = excel.Application.InchesToPoints(1.67)
DOUBLE_TOP_ADJUST = excel.Application.InchesToPoints(0.79)
DOUBLE_Bottom_ADJUST = excel.Application.InchesToPoints(3.96)
DOUBLE_LEFT_ADJUST = excel.Application.InchesToPoints(3.15)
TITLE_TOP_ADJUST = excel.Application.InchesToPoints(3)
TITLE_LEFT_ADJUST = excel.Application.InchesToPoints(1.3)
ES_SlideCounter = 1
ES_SlideName = "Summary"
ES_SlideName_prev = "Summary"
Set PA_Presentation = Application.ActivePresentation
'-------------------------------------------------------------------------------------
filePath = excel.Application.GetOpenFilename("Executive Summary (*.pptm*),*.pptm*", _
1, "Executive Summary Template to Populate", , False)
    If filePath = False Then GoTo noFile
Set ES_Presentation = Application.Presentations.Open(filePath)
'--------------------------------------------------------------------------------------
filePath = Replace(filePath, "pptm", "txt")
Open filePath For Output As [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=1]#1[/URL] 
For Each PA_slide In PA_Presentation.Slides
    
    'get the text from Title 1
    Title1Text = ""
    SlideShapeCount = PA_slide.Shapes.Count
    For I1 = 1 To SlideShapeCount Step 1
      If PA_slide.Shapes(I1).name = "Title 1" Then
        If PA_slide.Shapes(I1).HasTextFrame Then
          If PA_slide.Shapes(I1).TextFrame.HasText Then
            Title1Text = PA_slide.Shapes(I1).TextFrame.TextRange.Text
            Exit For
          End If
        End If
      End If
    Next I1
    'find out how many graphs on the PA slide get put on the ES slide with the tags on the shape
    wsNmbrOfGraphs = 0
    For Each PA_shape In PA_slide.Shapes
        'single graph on the slide
        If PA_slide.Tags("addSingleES") = "True" _
        And PA_shape.Tags.Item("Single") = "True" Then
            wsNmbrOfGraphs = wsNmbrOfGraphs + 1
        End If
        'just the top slide selected of a 2 graph slide
        If PA_slide.Tags("addTopES") = "True" _
        And PA_shape.Tags.Item("Top") = "True" Then
            wsNmbrOfGraphs = wsNmbrOfGraphs + 1
        End If
        'just the bottom slide selected of a 2 graph slide
        If PA_slide.Tags("addBottomES") = "True" _
        And PA_shape.Tags.Item("Bottom") = "True" Then
            wsNmbrOfGraphs = wsNmbrOfGraphs + 1
        End If
    Next PA_shape
    'take the selected graphs from the PA and put them on the ES
    SecondGraph = "N"
    For Each PA_shape In PA_slide.Shapes
        wsGraphType = ""
        
        'put the title shape on the ES
        If PA_shape.Tags.Item("titleShape") = "True" Then
            wsGraphType = "Title"
            copyChart PA_shape, ES_Presentation.Slides(ES_SlideName), TITLE_TOP_ADJUST, TITLE_LEFT_ADJUST, _
              ES_SlideName, ES_SlideName_prev, ES_SlideCounter, SecondGraph, wsShapename, Title1Text, wsGraphType
        End If
        
        'put the graph on the ES for slides with just one graph on the PA
        If PA_slide.Tags("addSingleES") = "True" _
        And PA_shape.Tags.Item("Single") = "True" Then
            wsWidth = PA_shape.Width
            wsGraphType = "Single"
            copyChart PA_shape, ES_Presentation.Slides(ES_SlideName), SINGLE_TOP_ADJUST, SINGLE_LEFT_ADJUST, _
              ES_SlideName, ES_SlideName_prev, ES_SlideCounter, SecondGraph, wsShapename, Title1Text, wsGraphType
        End If
        
        'put the top graph on the ES for slides with just the top graph selected
        If PA_slide.Tags("addTopES") = "True" _
        And PA_shape.Tags.Item("Top") = "True" _
        And wsNmbrOfGraphs = 1 Then
            wsGraphType = "Top Only"
            copyChart PA_shape, ES_Presentation.Slides(ES_SlideName), SINGLE_TOP_ADJUST, SINGLE_LEFT_ADJUST_narrow, _
              ES_SlideName, ES_SlideName_prev, ES_SlideCounter, SecondGraph, wsShapename, Title1Text, wsGraphType
        End If
        
        'put the bottom graph on the ES for slides with just the bottom graph selected
        If PA_slide.Tags("addBottomES") = "True" _
        And PA_shape.Tags.Item("Bottom") = "True" _
        And wsNmbrOfGraphs = 1 Then
            wsGraphType = "Bottom Only"
            copyChart PA_shape, ES_Presentation.Slides(ES_SlideName), SINGLE_TOP_ADJUST, SINGLE_LEFT_ADJUST_narrow, _
              ES_SlideName, ES_SlideName_prev, ES_SlideCounter, SecondGraph, wsShapename, Title1Text, wsGraphType
        End If
        
        'put the top graph on the ES for slides with 2 graphs selected
        If PA_slide.Tags("addTopES") = "True" _
        And PA_shape.Tags.Item("Top") = "True" _
        And wsNmbrOfGraphs = 2 Then
            If SecondGraph = "N" Then
               ES_SlideName_send = ES_SlideName
            Else
               ES_SlideName_send = ES_SlideName_prev
            End If
            wsGraphType = "Top"
            copyChart PA_shape, ES_Presentation.Slides(ES_SlideName_send), DOUBLE_TOP_ADJUST, DOUBLE_LEFT_ADJUST, _
              ES_SlideName, ES_SlideName_prev, ES_SlideCounter, SecondGraph, wsShapename, Title1Text, wsGraphType
            SecondGraph = "Y"
        End If
        
        'put the bottom graph on the ES for slides with 2 graphs selected
        If PA_slide.Tags("addBottomES") = "True" _
        And PA_shape.Tags.Item("Bottom") = "True" _
        And wsNmbrOfGraphs = 2 Then
            If SecondGraph = "N" Then
               ES_SlideName_send = ES_SlideName
            Else
               ES_SlideName_send = ES_SlideName_prev
            End If
            wsGraphType = "Bottom"
            copyChart PA_shape, ES_Presentation.Slides(ES_SlideName_send), DOUBLE_Bottom_ADJUST, DOUBLE_LEFT_ADJUST, _
              ES_SlideName, ES_SlideName_prev, ES_SlideCounter, SecondGraph, wsShapename, Title1Text, wsGraphType
            SecondGraph = "Y"
        End If
    Next PA_shape
Next PA_slide
    
On Error GoTo noFile
ES_Presentation.Slides(ES_SlideName).Delete
'MsgBox ("The Macro has Finished")
noFile:
Close [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=1]#1[/URL] 
End Sub
```


----------



## areed1192 (Dec 30, 2018)

*Re: VBA code to copy each picture from this workbook into a blank Powerpoint? I have a little...*

Sorry, I got a little busy yesterday, so I wasn't able to look at this till just now. I went ahead and made a script that should achieve the bulk of what you're doing, but I made a ton of assumptions, so it is by no means perfect. Ideally, you'll be able to look at this code and modify it to fit your unique situation.

Just so you're aware I wanted you to know the assumptions I made in this script.



The presentation will always have nine slides — one for the title page and 8 for the images.
There will always be* ONLY 4 images *on each worksheet in the ERP workbook.
That each of the image slides will ONLY have three shapes. *Two images and 1 title box*
The first image on the slide will* ALWAYS BE THE TOP ONE*.
The second image on the slide will *ALWAYS BE THE BOTTOM ONE*.
This script is not adjusting the *TITLE BOX*, you will need to add that.

With these assumptions, you should be able to look at my code and decipher the intent with relative ease. As always please don't hesitate to ask clarifying questions, I tried to put in a bunch of comments, but I also know sometimes that doesn't still do the trick.


```
Sub CreateExecSummary()
        
    'Declare PowerPoint Variables
    Dim PPTApp As PowerPoint.Application
    Dim PPTPres As PowerPoint.Presentation
    Dim PPTSlide As PowerPoint.Slide
    Dim PPTShape As PowerPoint.Shape
    Dim SldArray As Variant
    
    'Declare Excel Variables.
    Dim filePath As String
    Dim WrkSht As Worksheet
    Dim PicCntr, SldCntr, ShpCount As Integer
    Dim Shp As Shape


    'Open a file dialog to go and fetch the file path, if invalid file path is presented it will exit sub.
    filePath = Excel.Application.GetOpenFilename("Executive Summary (*.pptm*),*.pptm*", _
                                                 1, "Executive Summary Template to Populate", , False)
    If filePath = "" Then GoTo noFile
    
    'Check if the PowerPoint App is open, if not create a new instance of PowerPoint and finally make the PowerPoint Visible.
    On Error Resume Next
       Set PPTApp = GetObject(, "PowerPoint.Application")
    On Error GoTo 0


    If PPTApp Is Nothing Then
       Set PPTApp = New PowerPoint.Application
    End If
    
    'Make PowerPoint Visible
    PPTApp.Visible = True


    'Set the Presentation to the file select.
    Set PPTPres = PPTApp.Presentations.Open(filePath)
    
    'Build a slide array so we can easily paste the pictures on the right slide.
    SldArray = Array(2, 2, 3, 3, 4, 4, 5, 5, 6, 6, 7, 7, 8, 8, 9, 9)
    PicCntr = 0
    
    'Loop through each of the worksheets in the ERP Generated Workbook
    For Each WrkSht In ActiveWorkbook.Worksheets
    
        'Activate the Worksheet, for stability issues that may arise.
        WrkSht.Activate
        
        'Loop through each shape on the Worksheet.
        For Each Shp In WrkSht.Shapes
        
            'If the shape is a picture, then continue.
            If Shp.Type = msoPicture Then
               
               'Set a reference to the slide, we select the right slide by leveraging the PicCntr.
               Set PPTSlide = PPTPres.Slides(SldArray(PicCntr))
                
                   'Copy the shape, and pause for stability issues that may arise.
                   Shp.Copy
                   Application.Wait Now() + #12:00:01 AM#
                   
                   'Paste the shape and increase the PicCntr by 1, so that we proceed to the next element in our SldArray on the next pic.
                   PPTSlide.Shapes.Paste
                   PicCntr = PicCntr + 1
                 
               'Get the total shape count, and set a reference to the shape we want to work with.
               ShpCount = PPTSlide.Shapes.Count
               Set PPTShape = PPTSlide.Shapes(ShpCount)
               
               'Assume the First Shape is the Top one, the reason I put ShpCount 2 is that we have to include the title box.
               If ShpCount = 2 Then
                                 
                    'Set the dimensions of the shape.
                    With PPTShape
                         .Top = Excel.Application.InchesToPoints(0.42)
                         .Left = Excel.Application.InchesToPoints(2.92)
                    End With
                                   
               'Assume the Second Shape is the bottom one, the reason I put ShpCount 3 is that we have to include the title box.
               ElseIf ShpCount = 3 Then
               
                    'Set the dimensions of the shape.
                    With PPTShape
                         .Top = Excel.Application.InchesToPoints(3.92)
                         .Left = Excel.Application.InchesToPoints(2.92)
                    End With
               
               End If
            End If
        Next
    Next


'Let the user know the macro finished running.
MsgBox "The Macro has finished running; you may now work with the PowerPoint Presentation."


Exit Sub


'Handle the No File Error.
noFile:
MsgBox "We Couldn't find the file, exiting the Macro."


End Sub
```


----------



## ajjava (Dec 31, 2018)

*Re: VBA code to copy each picture from this workbook into a blank Powerpoint?*

Everything goes well until this line of code. I really tried, but it's beyond me to figure out why it gets angry at this spot. Any ideas?


----------



## ajjava (Dec 31, 2018)

*Re: VBA code to copy each picture from this workbook into a blank Powerpoint?*



ajjava said:


> Everything goes well until this line of code. I really tried, but it's beyond me to figure out why it gets angry at this spot. Any ideas?



Is the problem the fact that I'll ultimately have 22 slides in the PPT? The ERP workbook will always be 11 tabs with 4 pic/shapes each, thereby making the PPT 22 slides (at 2 pic/shapes per slide)?


----------



## areed1192 (Dec 31, 2018)

*Re: VBA code to copy each picture from this workbook into a blank Powerpoint?*



ajjava said:


> Is the problem the fact that I'll ultimately have 22 slides in the PPT? The ERP workbook will always be 11 tabs with 4 pic/shapes each, thereby making the PPT 22 slides (at 2 pic/shapes per slide)?



Yes, that will cause a problem because it probably is coming up with an error that says it is out of range. What we have to do is increase our slide array to handle all 22 slides.

In this case, let's use a loop to build the slide array. Replace the following code:


```
[COLOR=#574123] '[/COLOR]Build a slide array so we can easily paste the pictures on the right slide.
 SldArray = Array(2, 2, 3, 3, 4, 4, 5, 5, 6, 6, 7, 7, 8, 8, 9, 9)
```

With the following:


```
'Build a slide array so that way we can easily paste the pictures on the right slide.
    StartingSld = 2


    For i = 0 To 41 Step 2
        SldArray(i) = StartingSld
        SldArray(i + 1) = StartingSld
        StartingSld = StartingSld + 1
    Next
```

This will produce a slide array that goes from slide 2 to 22 (the number of slides you have). To prove it simply print it out:


```
For i = LBound(SldArray) To UBound(SldArray)
        Debug.Print (SldArray(i))
    Next i
```

Let me know if this fixes the problem. The biggest problem is making sure that the Slide array only loops through the slides we don't want aka the title slide.


----------



## ajjava (Jan 2, 2019)

*Re: VBA code to copy each picture from this workbook into a blank Powerpoint?*

It starts off ok, but then this error comes up:





Do I need to declare some sort of variable for "StartlingSld"?


----------



## areed1192 (Jan 2, 2019)

*Re: VBA code to copy each picture from this workbook into a blank Powerpoint?*

Here is the full code, it's because there isn't a variable called "StartingSld" declared. If you have option Explicit at the top you need to have all your variables declared.


```
Option Explicit


Sub CreateExecSummary()
        
    'Declare PowerPoint Variables
    Dim PPTApp As PowerPoint.Application
    Dim PPTPres As PowerPoint.Presentation
    Dim PPTSlide As PowerPoint.Slide
    Dim PPTShape As PowerPoint.Shape
    Dim SldArray(44) As Variant
    
    'Declare Excel Variables.
    Dim filePath As String
    Dim WrkSht As Worksheet
    Dim PicCntr, SldCntr, ShpCount, StartingSld As Integer
    Dim Shp As Shape


    'Open a file dialog to go and fetch the file path, if invalid file path is presented it will exit sub.
    filePath = Excel.Application.GetOpenFilename("Executive Summary (*.pptm*),*.pptm*", _
                                                 1, "Executive Summary Template to Populate", , False)
    If filePath = "" Then GoTo noFile
    
    'Check if the PowerPoint App is open, if not create a new instance of PowerPoint and finally make the PowerPoint Visible.
    On Error Resume Next
       Set PPTApp = GetObject(, "PowerPoint.Application")
    On Error GoTo 0


    If PPTApp Is Nothing Then
       Set PPTApp = New PowerPoint.Application
    End If
    
    'Make PowerPoint Visible
    PPTApp.Visible = True


    'Set the Presentation to the file select.
    Set PPTPres = PPTApp.Presentations.Open(filePath)
    
    'Build a slide array so that way we can easily paste the pictures on the right slide.
    StartingSld = 2


    For i = 0 To 41 Step 2
        SldArray(i) = StartingSld
        SldArray(i + 1) = StartingSld
        StartingSld = StartingSld + 1
    Next
    
    PicCntr = 0
    
    'Loop through each of the worksheets in the ERP Generated Workbook
    For Each WrkSht In ActiveWorkbook.Worksheets
    
        'Activate the Worksheet, for stability issues that may arise.
        WrkSht.Activate
        
        'Loop through each shape on the Worksheet.
        For Each Shp In WrkSht.Shapes
        
            'If the shape is a picture, then continue.
            If Shp.Type = msoPicture Then
               
               'Set a reference to the slide, we select the right slide by leveraging the PicCntr.
               Set PPTSlide = PPTPres.Slides(SldArray(PicCntr))
                
                   'Copy the shape, and pause for stability issues thay may arise.
                   Shp.Copy
                   Application.Wait Now() + #12:00:01 AM#
                   
                   'Paste the shape and increase the PicCntr by 1, so that we proceed to the next element in our SldArray on the next pic.
                   PPTSlide.Shapes.Paste
                   PicCntr = PicCntr + 1
                 
               'Get the total shape count, and set a reference to the shape we want to work with.
               ShpCount = PPTSlide.Shapes.Count
               Set PPTShape = PPTSlide.Shapes(ShpCount)
               
               'Assume the First Shape is the Top one, the reason I put ShpCount 2 is because we have to include the title box.
               If ShpCount = 2 Then
                                 
                    'Set the dimensions of the shape.
                    With PPTShape
                         .Top = Excel.Application.InchesToPoints(0.42)
                         .Left = Excel.Application.InchesToPoints(2.92)
                    End With
                                   
               'Assume the Second Shape is the bottom one, the reason I put ShpCount 3 is because we have to include the title box.
               ElseIf ShpCount = 3 Then
               
                    'Set the dimensions of the shape.
                    With PPTShape
                         .Top = Excel.Application.InchesToPoints(3.92)
                         .Left = Excel.Application.InchesToPoints(2.92)
                    End With
               
               End If
            End If
        Next
    Next


'Let the user know the macro finished running.
MsgBox "The Macro has finished running, you may now work with the PowerPoint Presentation."


Exit Sub


'Handle the No File Error.
noFile:
MsgBox "We Couldn't find the file, exiting the Macro."


End Sub
```


----------



## ajjava (Jan 2, 2019)

*Re: VBA code to copy each picture from this workbook into a blank Powerpoint?*

Now I'm getting this message, after copy/pasting your latest code:


----------



## areed1192 (Jan 2, 2019)

*Re: VBA code to copy each picture from this workbook into a blank Powerpoint?*

Can you paste your code? I'm not getting any errors on my end when I run it.


----------



## ajjava (Jan 2, 2019)

*Re: VBA code to copy each picture from this workbook into a blank Powerpoint?*

The PPTpres that the procedure opens should have the correct number of blank slides, before running the code, right? Maybe I'm having an issue in PPT?


```
Sub CreateExecSummary2()
'Code by areed1192
'Assumptions

'There will always be ONLY 4 images on each worksheet in the ERP workbook.
'That each of the image slides will ONLY have three shapes. Two images and 1 title box
'The first image on the slide will ALWAYS BE THE TOP ONE.
'The second image on the slide will ALWAYS BE THE BOTTOM ONE.
        
    'Declare PowerPoint Variables
    Dim PPTApp As PowerPoint.Application
    Dim PPTPres As PowerPoint.Presentation
    Dim PPTSlide As PowerPoint.Slide
    Dim PPTShape As PowerPoint.Shape
    Dim SldArray(44) As Variant
    
    'Declare Excel Variables.
    Dim filePath As String
    Dim WrkSht As Worksheet
    Dim PicCntr, SldCntr, ShpCount, StartingSld As Integer
    Dim Shp As Shape

    'Open a file dialog to go and fetch the file path, if invalid file path is presented it will exit sub.
    filePath = Excel.Application.GetOpenFilename("Executive Summary (*.pptm*),*.pptm*", _
                                                 1, "Executive Summary Template to Populate", , False)
    If filePath = "" Then GoTo noFile
    
    'Check if the PowerPoint App is open, if not create a new instance of PowerPoint and finally make the PowerPoint Visible.
    On Error Resume Next
       Set PPTApp = GetObject(, "PowerPoint.Application")
    On Error GoTo 0

    If PPTApp Is Nothing Then
       Set PPTApp = New PowerPoint.Application
    End If
    
    'Make PowerPoint Visible
    PPTApp.Visible = True

    'Set the Presentation to the file select.
    Set PPTPres = PPTApp.Presentations.Open(filePath)
    
    'Build a slide array so that way we can easily paste the pictures on the right slide.
    StartingSld = 2

    For i = 0 To 41 Step 2
        SldArray(i) = StartingSld
        SldArray(i + 1) = StartingSld
        StartingSld = StartingSld + 1
    Next
    
    PicCntr = 0
    
    'Loop through each of the worksheets in the ERP Generated Workbook
    For Each WrkSht In ActiveWorkbook.Worksheets
    
        'Activate the Worksheet, for stability issues that may arise.
        WrkSht.Activate
        
        'Loop through each shape on the Worksheet.
        For Each Shp In WrkSht.Shapes
        
            'If the shape is a picture, then continue.
            If Shp.Type = msoPicture Then
               
               'Set a reference to the slide, we select the right slide by leveraging the PicCntr.
               Set PPTSlide = PPTPres.Slides(SldArray(PicCntr))
                
                   'Copy the shape, and pause for stability issues thay may arise.
                   Shp.Copy
                   Application.Wait Now() + #12:00:01 AM#
                   
                   'Paste the shape and increase the PicCntr by 1, so that we proceed to the next element in our SldArray on the next pic.
                   PPTSlide.Shapes.Paste
                   PicCntr = PicCntr + 1
                 
               'Get the total shape count, and set a reference to the shape we want to work with.
               ShpCount = PPTSlide.Shapes.Count
               Set PPTShape = PPTSlide.Shapes(ShpCount)
               
               'Assume the First Shape is the Top one, the reason I put ShpCount 2 is because we have to include the title box.
               If ShpCount = 2 Then
                                 
                    'Set the dimensions of the shape.
                    With PPTShape
                         .Top = Excel.Application.InchesToPoints(0.42)
                         .Left = Excel.Application.InchesToPoints(2.92)
                    End With
                                   
               'Assume the Second Shape is the bottom one, the reason I put ShpCount 3 is because we have to include the title box.
               ElseIf ShpCount = 3 Then
               
                    'Set the dimensions of the shape.
                    With PPTShape
                         .Top = Excel.Application.InchesToPoints(3.92)
                         .Left = Excel.Application.InchesToPoints(2.92)
                    End With
               
               End If
            End If
        Next
    Next

'Let the user know the macro finished running.
MsgBox "The Macro has finished running, you may now work with the PowerPoint Presentation."

Exit Sub

'Handle the No File Error.
noFile:
MsgBox "We Couldn't find the file, exiting the Macro."

End Sub
```


----------



## ajjava (Dec 19, 2018)

...bit of the code, but not all of it. The excel file contains what appear to be charts, but they're really pictures. I want a macro to copy any picture on a visible worksheet into a PPT presentation. I have the code worked out to create a new, blank PPT and it does work to copy a few of the images to the PPT, but then it falls apart during the For Each section. I know enough to be dangerous but certainly am no expert. So, to recap:

* Start in excel workbook
* For each picture, on each visible worksheet, copy the picture and...
* Create a new powerpoint presentation
* Insert a new slide
* Paste each picture from the workbook onto a new slide
* Adjust the slide size/position

Here is my existing code (pieced together from various sources). Chart-specific lines have been commented out, since I'm not really working with charts (charts have been pasted into excel as pictures, via SAP/Biz Objects):


```
Public Sub TestCopyPastePic()
'Declare the needed variables
    Dim newPP As PowerPoint.Application
    Dim currentSlide As PowerPoint.Slide
    Dim XShape As Excel.Shape
    Dim ws As Worksheet
 'Check if PowerPoint is active
    On Error Resume Next
    Set newPP = GetObject(, "PowerPoint.Application")
    On Error GoTo 0
'Open PowerPoint if not active
    If newPP Is Nothing Then
        Set newPP = New PowerPoint.Application
    End If
'Create new presentation in PowerPoint
    If newPP.Presentations.Count = 0 Then
        newPP.Presentations.Add
    End If
'Display the PowerPoint presentation
    'newPowerPoint.Visible = True

'Locate Excel charts to paste into the new PowerPoint presentation
    
    For Each ws In ActiveWorkbook.Worksheets
    
        If ws.Visible Then
            For Each XShape In ActiveSheet.Shapes
            'Add a new slide in PowerPoint for each Excel chart
                newPP.ActivePresentation.Slides.Add newPP.ActivePresentation.Slides.Count + 1, ppLayoutText
                newPP.ActiveWindow.View.GotoSlide newPP.ActivePresentation.Slides.Count
                Set currentSlide = newPP.ActivePresentation.Slides(newPP.ActivePresentation.Slides.Count)
    
            'Copy each Excel chart and paste it into PowerPoint as an Metafile image
                XShape.Select
                Selection.Copy
                currentSlide.Shapes.PasteSpecial(DataType:=ppPasteMetafilePicture).Select
            'Copy and paste chart title as the slide title in PowerPoint
           ' currentSlide.Shapes(1).TextFrame.TextRange.Text = cht.Chart.ChartTitle.Text
    
            'Adjust the slide position for each chart slide in PowerPoint. Note that you can adjust the values to position the chart on the slide to your liking
                newPP.ActiveWindow.Selection.ShapeRange.Left = 25
                newPP.ActiveWindow.Selection.ShapeRange.Top = 150
                currentSlide.Shapes(2).Width = 250
                currentSlide.Shapes(2).Left = 500
            Next XShape
          Else
          'Next ws
          End If
    Next ws
AppActivate ("Microsoft PowerPoint")
Set currentSlide = Nothing
Set newPP = Nothing
End Sub
```


----------



## areed1192 (Jan 2, 2019)

*Re: VBA code to copy each picture from this workbook into a blank Powerpoint?*

So here was the problem, technically we didn't have 22 slides in the presentation we had 23. The reason that error was popping up was that when we were pasting the shapes it was looking for slide 23 when there was only slide 22. In order to fix this we have changed our array loop from 41 to 42. Here is the full code for your reference:

Also I added a new variable "Dim i as integer"

Try it out and let me know if that fixes the issue.


```
Sub CreateExecSummary2()
'Code by areed1192
'Assumptions


'There will always be ONLY 4 images on each worksheet in the ERP workbook.
'That each of the image slides will ONLY have three shapes. Two images and 1 title box
'The first image on the slide will ALWAYS BE THE TOP ONE.
'The second image on the slide will ALWAYS BE THE BOTTOM ONE.
        
    'Declare PowerPoint Variables
    Dim PPTApp As PowerPoint.Application
    Dim PPTPres As PowerPoint.Presentation
    Dim PPTSlide As PowerPoint.Slide
    Dim PPTShape As PowerPoint.Shape
    Dim SldArray(44) As Variant
    Dim i As Integer
    
    'Declare Excel Variables.
    Dim filePath As String
    Dim WrkSht As Worksheet
    Dim PicCntr, SldCntr, ShpCount, StartingSld As Integer
    Dim Shp As Shape


    'Open a file dialog to go and fetch the file path, if invalid file path is presented it will exit sub.
    filePath = Excel.Application.GetOpenFilename("Executive Summary (*.pptm*),*.pptm*", _
                                                 1, "Executive Summary Template to Populate", , False)
    If filePath = "" Then GoTo noFile
    
    'Check if the PowerPoint App is open, if not create a new instance of PowerPoint and finally make the PowerPoint Visible.
    On Error Resume Next
       Set PPTApp = GetObject(, "PowerPoint.Application")
    On Error GoTo 0


    If PPTApp Is Nothing Then
       Set PPTApp = New PowerPoint.Application
    End If
    
    'Make PowerPoint Visible
    PPTApp.Visible = True


    'Set the Presentation to the file select.
    Set PPTPres = PPTApp.Presentations.Open(filePath)
    
    'Build a slide array so that way we can easily paste the pictures on the right slide.
    StartingSld = 2


    For i = 0 To 42 Step 2
        SldArray(i) = StartingSld
        SldArray(i + 1) = StartingSld
        StartingSld = StartingSld + 1
    Next
    
    PicCntr = 0
    
    'Loop through each of the worksheets in the ERP Generated Workbook
    For Each WrkSht In ActiveWorkbook.Worksheets
    
        'Activate the Worksheet, for stability issues that may arise.
        WrkSht.Activate
        
        'Loop through each shape on the Worksheet.
        For Each Shp In WrkSht.Shapes
        
            'If the shape is a picture, then continue.
            If Shp.Type = msoPicture Then
               
               'Set a reference to the slide, we select the right slide by leveraging the PicCntr.
               Set PPTSlide = PPTPres.Slides(SldArray(PicCntr))
                
                   'Copy the shape, and pause for stability issues thay may arise.
                   Shp.Copy
                   Application.Wait Now() + #12:00:01 AM#
                   
                   'Paste the shape and increase the PicCntr by 1, so that we proceed to the next element in our SldArray on the next pic.
                   PPTSlide.Shapes.Paste
                   PicCntr = PicCntr + 1
                 
               'Get the total shape count, and set a reference to the shape we want to work with.
               ShpCount = PPTSlide.Shapes.Count
               Set PPTShape = PPTSlide.Shapes(ShpCount)
               
               'Assume the First Shape is the Top one, the reason I put ShpCount 2 is because we have to include the title box.
               If ShpCount = 2 Then
                                 
                    'Set the dimensions of the shape.
                    With PPTShape
                         .Top = Excel.Application.InchesToPoints(0.42)
                         .Left = Excel.Application.InchesToPoints(2.92)
                    End With
                                   
               'Assume the Second Shape is the bottom one, the reason I put ShpCount 3 is because we have to include the title box.
               ElseIf ShpCount = 3 Then
               
                    'Set the dimensions of the shape.
                    With PPTShape
                         .Top = Excel.Application.InchesToPoints(3.92)
                         .Left = Excel.Application.InchesToPoints(2.92)
                    End With
               
               End If
            End If
        Next
    Next


'Let the user know the macro finished running.
MsgBox "The Macro has finished running, you may now work with the PowerPoint Presentation."


Exit Sub


'Handle the No File Error.
noFile:
MsgBox "We Couldn't find the file, exiting the Macro."


End Sub
```


----------



## ajjava (Jan 2, 2019)

*Re: VBA code to copy each picture from this workbook into a blank Powerpoint?*

Ok, good news! All shapes copied over to the PPT!! Now, I'm trying to understand positioning/sizing. I don't see anything in your code that would dictate the size of each shape (and in fact, I don't think I ever mentioned anything about size). I should've done this a long time ago, but here is an example of how the "finished" slide should look, after the shapes have been pasted/sized/positioned, title box added. Given the params in Format Picture dialogue, what should I add to the code? Also, again, I can't thank you enough for your prompt and patient assistance


----------



## areed1192 (Jan 2, 2019)

*Re: VBA code to copy each picture from this workbook into a blank Powerpoint?*

This is the section that determines the position. I modified it to match the height and width in your photo, so just paste this over the original. Glad to hear it is finally working! 


```
'Assume the First Shape is the Top one, the reason I put ShpCount 2 is that we have to include the title box.
If ShpCount = 2 Then
                                 
'Set the dimensions of the shape.
With PPTShape
.Top = Excel.Application.InchesToPoints(0.42)
.Left = Excel.Application.InchesToPoints(2.92)
.Height = Excel.Application.InchesToPoints(3.13)
.Width = Excel.Application.InchesToPoints(6.53)
End With
                                   
'Assume the Second Shape is the bottom one, the reason I put ShpCount 3 is that we have to include the title box.
ElseIf ShpCount = 3 Then
               
'Set the dimensions of the shape.
With PPTShape
.Top = Excel.Application.InchesToPoints[COLOR=#ff0000](3.92) CHANGE THIS SO IT MATCHES WHAT YOU HAVE FOR THE BOTTOM IMAGE.[/COLOR]
.Left = Excel.Application.InchesToPoints(2.92)
.Height = Excel.Application.InchesToPoints(3.13)
.Width = Excel.Application.InchesToPoints(6.53)
End With
               
End If
```


----------



## ajjava (Jan 2, 2019)

*Re: VBA code to copy each picture from this workbook into a blank Powerpoint?*

More progress made. But, the first shape on each slide is seemingly unaffected by the dimensions in the code. Also, may I have the necessary code to add the rectangle text box that should appear on the left side of each slide?


----------



## areed1192 (Jan 2, 2019)

*Re: VBA code to copy each picture from this workbook into a blank Powerpoint?*

Add the following code after the ShpCount 3 section, this will add the text box.


```
'Assume the Second Shape is the bottom one, the reason I put ShpCount 3 is because we have to include the title box.
               ElseIf ShpCount = 3 Then
               
                    'Set the dimensions of the shape.
                    With PPTShape
                         .Top = Excel.Application.InchesToPoints(3.92)
                         .Left = Excel.Application.InchesToPoints(3.15)
                    End With
               
               End If
               
[COLOR=#ff0000]               'Add the text box.[/COLOR]
[COLOR=#ff0000]               PPTSlide.Shapes.AddShape(Type:=msoShapeRectangle, Left:=38, Top:=43, Width:=317, Height:=465).TextFrame.TextRange.Text = "Please Enter Analysis Here."[/COLOR]
```

As for the why it's formatting the wrong shape. I can't really tell because you might have more shapes on the slide then just 3. If you do it'll throw it off, so you'll need to play around and see if the shape number is different.


----------



## ajjava (Jan 3, 2019)

*Re: VBA code to copy each picture from this workbook into a blank Powerpoint?*

I understand about the number of shapes. So, about that - what does the "base" PPT look like that you've been using in your testing? For instance, does every slide have a title box and nothing else? I'm guessing that the PPT structure is, in fact, the problem, as you've said. If it's easier or more beneficial, I'm happy to send you the actual PPT.


----------



## areed1192 (Jan 3, 2019)

*Re: VBA code to copy each picture from this workbook into a blank Powerpoint?*









https://1drv.ms/u/s!ArYl2nzFQMaLirYP-KjEl24xo-paRA

Here is a link to the image of how I have my slides laid out. If they follow some structure like this, it should work. Maybe share a link to the file on google drive or something I can download it and see a slide and how it's laid out.


----------



## ajjava (Jan 3, 2019)

*Re: VBA code to copy each picture from this workbook into a blank Powerpoint?*

YES!! I've got it all working! My slides had more shapes on them than you realized, so I had to fix that. Now, after doing that, your code works GREAT!! I just need to adjust the position/shape of the charts and then I'm good to go!!! I CANNOT THANK YOU ENOUGH FOR YOUR ASSISTANCE WITH THIS!!!!!!!!!!!!!!!!!!!!!!!


----------



## areed1192 (Jan 3, 2019)

*Re: VBA code to copy each picture from this workbook into a blank Powerpoint?*



ajjava said:


> YES!! I've got it all working! My slides had more shapes on them than you realized, so I had to fix that. Now, after doing that, your code works GREAT!! I just need to adjust the position/shape of the charts and then I'm good to go!!! I CANNOT THANK YOU ENOUGH FOR YOUR ASSISTANCE WITH THIS!!!!!!!!!!!!!!!!!!!!!!!



Glad you were able to get it working!


----------

