going through multiple worksheets and copying all charts from them

D

d1e9v85

New Member
Joined
May 1, 2018
Messages
11
Hello experts,

I have the code below that works well to export excel graphs onto powerpoint. But where I am stuck is that it only exports the graphs from the active worksheet.

How can I make it cycle through all the whole workbook and then export the graphs sheet by sheet?

Thanks


Code: 
Option Base 1


Sub CreatePowerPoint()


'First we declare the variables we will be using
    Dim newPowerPoint As PowerPoint.Application
    Dim activeSlide As PowerPoint.Slide
    Dim cht As Excel.ChartObject
    Dim pptPres As PowerPoint.Presentation


 'Look for existing instance
    On Error Resume Next
    Set newPowerPoint = GetObject(, "PowerPoint.Application")
    On Error GoTo 0


'Let's create a new PowerPoint
    If newPowerPoint Is Nothing Then
        Set newPowerPoint = New PowerPoint.Application
    End If
'Make a presentation in PowerPoint
    strFileToOpen = Application.GetOpenFilename(FileFilter:="Powerpoint Files *.pptx (*.pptx),")
    If strFileToOpen = False Then Exit Sub
    Set newPowerPoint = New PowerPoint.Application
    newPowerPoint.Visible = True
    Set pptPres = newPowerPoint.Presentations.Open(Filename:=strFileToOpen, ReadOnly:=msoFalse)


    If newPowerPoint.Presentations.Count = 0 Then
        newPowerPoint.Presentations.Add
    End If


'Loop through each chart in the Excel worksheet and paste them into the PowerPoint
    For i = 1 To ActiveSheet.ChartObjects.Count
        Set cht = ActiveSheet.ChartObjects(i)
            
    'Add a new slide where we will paste the chart
    chartNum = (i - 1) Mod 4
    If chartNum = 0 Then
        newPowerPoint.ActivePresentation.Slides.Add newPowerPoint.ActivePresentation.Slides.Count + 1, ppLayoutBlank
    End If




       newPowerPoint.ActiveWindow.View.GotoSlide newPowerPoint.ActivePresentation.Slides.Count
        Set activeSlide = newPowerPoint.ActivePresentation.Slides(newPowerPoint.ActivePresentation.Slides.Count)


    'Copy the chart and paste it into the PowerPoint as a Metafile Picture
        cht.Select
        ActiveChart.ChartArea.Copy
        activeSlide.Shapes.PasteSpecial(DataType:=ppPasteMetafilePicture).Select


    'Set the title of the slide the same as the title of the chart
        'activeSlide.Shapes(1).TextFrame.TextRange.Text = cht.Chart.ChartTitle.Text


    'Adjust the positioning of the Chart on Powerpoint Slide
  If chartNum = 0 Then
        newPowerPoint.ActiveWindow.Selection.ShapeRange.Left = 50
        newPowerPoint.ActiveWindow.Selection.ShapeRange.Top = 70
    ElseIf chartNum = 1 Then
        newPowerPoint.ActiveWindow.Selection.ShapeRange.Left = 528
        newPowerPoint.ActiveWindow.Selection.ShapeRange.Top = 70
    ElseIf chartNum = 2 Then
        newPowerPoint.ActiveWindow.Selection.ShapeRange.Left = 50
        newPowerPoint.ActiveWindow.Selection.ShapeRange.Top = 300
    Else
        newPowerPoint.ActiveWindow.Selection.ShapeRange.Left = 528
        newPowerPoint.ActiveWindow.Selection.ShapeRange.Top = 300
    End If


    newPowerPoint.ActiveWindow.Selection.ShapeRange.Height = 300
    newPowerPoint.ActiveWindow.Selection.ShapeRange.Width = 350


    Next


Set activeSlide = Nothing
Set newPowerPoint = Nothing
Set pptPres = Nothing


End Sub
 

Excel Facts

Excel Can Read to You
Customize Quick Access Toolbar. From All Commands, add Speak Cells or Speak Cells on Enter to QAT. Select cells. Press Speak Cells.
Sort by date Sort by votes
Using this snippet....

Code: 
Sub WorksheetLoop2()


         ' Declare Current as a worksheet object variable.
         Dim Current As Worksheet


         ' Loop through all of the worksheets in the active workbook.
         For Each Current In Worksheets


            ' Insert your code here.
            ' This line displays the worksheet name in a message box.
            MsgBox Current.Name
         Next


      End Sub

We wrap your existing code in it...(mainly changing everything that says "Activesheet" to "Current"




Code: 
Option Base 1




Sub CreatePowerPoint()




'First we declare the variables we will be using
    Dim newPowerPoint As PowerPoint.Application
    Dim activeSlide As PowerPoint.Slide
    Dim cht As Excel.ChartObject
    Dim pptPres As PowerPoint.Presentation
[COLOR=#ff0000] ' Declare Current as a worksheet object variable.[/COLOR]
[COLOR=#ff0000]         Dim Current As Worksheet[/COLOR]





 'Look for existing instance
    On Error Resume Next
    Set newPowerPoint = GetObject(, "PowerPoint.Application")
    On Error GoTo 0




'Let's create a new PowerPoint
    If newPowerPoint Is Nothing Then
        Set newPowerPoint = New PowerPoint.Application
    End If
'Make a presentation in PowerPoint
    strFileToOpen = Application.GetOpenFilename(FileFilter:="Powerpoint Files *.pptx (*.pptx),")
    If strFileToOpen = False Then Exit Sub
    Set newPowerPoint = New PowerPoint.Application
    newPowerPoint.Visible = True
    Set pptPres = newPowerPoint.Presentations.Open(Filename:=strFileToOpen, ReadOnly:=msoFalse)




    If newPowerPoint.Presentations.Count = 0 Then
        newPowerPoint.Presentations.Add
    End If


[COLOR=#ff0000] ' Loop through all of the worksheets in the active workbook.[/COLOR]
[COLOR=#ff0000]         For Each Current In Worksheets[/COLOR]




'Loop through each chart in the Excel worksheet and paste them into the PowerPoint
    For i = 1 To Current.ChartObjects.Count
        Set cht = Current.ChartObjects(i)
            
    'Add a new slide where we will paste the chart
    chartNum = (i - 1) Mod 4
    If chartNum = 0 Then
        newPowerPoint.ActivePresentation.Slides.Add newPowerPoint.ActivePresentation.Slides.Count + 1, ppLayoutBlank
    End If








       newPowerPoint.ActiveWindow.View.GotoSlide newPowerPoint.ActivePresentation.Slides.Count
        Set activeSlide = newPowerPoint.ActivePresentation.Slides(newPowerPoint.ActivePresentation.Slides.Count)




    'Copy the chart and paste it into the PowerPoint as a Metafile Picture
        cht.Select
        ActiveChart.ChartArea.Copy
        activeSlide.Shapes.PasteSpecial(DataType:=ppPasteMetafilePicture).Select




    'Set the title of the slide the same as the title of the chart
        'activeSlide.Shapes(1).TextFrame.TextRange.Text = cht.Chart.ChartTitle.Text




    'Adjust the positioning of the Chart on Powerpoint Slide
  If chartNum = 0 Then
        newPowerPoint.ActiveWindow.Selection.ShapeRange.Left = 50
        newPowerPoint.ActiveWindow.Selection.ShapeRange.Top = 70
    ElseIf chartNum = 1 Then
        newPowerPoint.ActiveWindow.Selection.ShapeRange.Left = 528
        newPowerPoint.ActiveWindow.Selection.ShapeRange.Top = 70
    ElseIf chartNum = 2 Then
        newPowerPoint.ActiveWindow.Selection.ShapeRange.Left = 50
        newPowerPoint.ActiveWindow.Selection.ShapeRange.Top = 300
    Else
        newPowerPoint.ActiveWindow.Selection.ShapeRange.Left = 528
        newPowerPoint.ActiveWindow.Selection.ShapeRange.Top = 300
    End If




    newPowerPoint.ActiveWindow.Selection.ShapeRange.Height = 300
    newPowerPoint.ActiveWindow.Selection.ShapeRange.Width = 350




    Next
[COLOR=#ff0000]next[/COLOR]


Set activeSlide = Nothing
Set newPowerPoint = Nothing
Set pptPres = Nothing




End Sub
 
Upvote 0
Sorry Sent that previous post too quickly.

The code you posted works partially. It goes through the charts and pastes the graphs of the first sheet onto the first slide in Powerpoint.
But after that it keeps pasting the last graph from the first sheet onto the remaining ppt slides.

Need to make sure that all the graphs from all worksheets are copied and then pasted to the ppt
 
Upvote 0
I tried that too earlier. Same result.

Just so we are on same page

My first sheet has 3 graphs.
second also has 3
next one has 2
last one has 1

In the first ppt slide , the three graphs from first sheet are pasted correctly
in the next slide, it just pastes the last graph from first sheet 3 times
next slide, pastes the same graph twice
and last slide, pastes the same graph once

Thanks for helping out!
 
Upvote 0
ok thanks for clarifying. There is a count you're doing somewhere that isn't being reset when it loops to next sheet. Let me look more at your code.
 
Upvote 0
I reset the cht object but I think the problem here:
chartNum = (i - 1) Mod 4
So I reset that that with each sheet loop

Code: 
Option Base 1








Sub CreatePowerPoint()








'First we declare the variables we will be using
    Dim newPowerPoint As PowerPoint.Application
    Dim activeSlide As PowerPoint.Slide
    Dim cht As Excel.ChartObject
    Dim pptPres As PowerPoint.Presentation
 ' Declare Current as a worksheet object variable.
         Dim Current As Worksheet










 'Look for existing instance
    On Error Resume Next
    Set newPowerPoint = GetObject(, "PowerPoint.Application")
    On Error GoTo 0








'Let's create a new PowerPoint
    If newPowerPoint Is Nothing Then
        Set newPowerPoint = New PowerPoint.Application
    End If
'Make a presentation in PowerPoint
    strFileToOpen = Application.GetOpenFilename(FileFilter:="Powerpoint Files *.pptx (*.pptx),")
    If strFileToOpen = False Then Exit Sub
    Set newPowerPoint = New PowerPoint.Application
    newPowerPoint.Visible = True
    Set pptPres = newPowerPoint.Presentations.Open(Filename:=strFileToOpen, ReadOnly:=msoFalse)








    If newPowerPoint.Presentations.Count = 0 Then
        newPowerPoint.Presentations.Add
    End If




 ' Loop through all of the worksheets in the active workbook.
         For Each Current In Worksheets








'Loop through each chart in the Excel worksheet and paste them into the PowerPoint
    For i = 1 To Current.ChartObjects.Count
[COLOR=#ff0000]Set cht = nothing 'reset[/COLOR]
        Set cht = Current.ChartObjects(i)
            
    'Add a new slide where we will paste the chart
    chartNum = (i - 1) Mod 4
    If chartNum = 0 Then
        newPowerPoint.ActivePresentation.Slides.Add newPowerPoint.ActivePresentation.Slides.Count + 1, ppLayoutBlank
    End If
















       newPowerPoint.ActiveWindow.View.GotoSlide newPowerPoint.ActivePresentation.Slides.Count
        Set activeSlide = newPowerPoint.ActivePresentation.Slides(newPowerPoint.ActivePresentation.Slides.Count)








    'Copy the chart and paste it into the PowerPoint as a Metafile Picture
        cht.Select
        ActiveChart.ChartArea.Copy
        activeSlide.Shapes.PasteSpecial(DataType:=ppPasteMetafilePicture).Select








    'Set the title of the slide the same as the title of the chart
        'activeSlide.Shapes(1).TextFrame.TextRange.Text = cht.Chart.ChartTitle.Text








    'Adjust the positioning of the Chart on Powerpoint Slide
  If chartNum = 0 Then
        newPowerPoint.ActiveWindow.Selection.ShapeRange.Left = 50
        newPowerPoint.ActiveWindow.Selection.ShapeRange.Top = 70
    ElseIf chartNum = 1 Then
        newPowerPoint.ActiveWindow.Selection.ShapeRange.Left = 528
        newPowerPoint.ActiveWindow.Selection.ShapeRange.Top = 70
    ElseIf chartNum = 2 Then
        newPowerPoint.ActiveWindow.Selection.ShapeRange.Left = 50
        newPowerPoint.ActiveWindow.Selection.ShapeRange.Top = 300
    Else
        newPowerPoint.ActiveWindow.Selection.ShapeRange.Left = 528
        newPowerPoint.ActiveWindow.Selection.ShapeRange.Top = 300
    End If








    newPowerPoint.ActiveWindow.Selection.ShapeRange.Height = 300
    newPowerPoint.ActiveWindow.Selection.ShapeRange.Width = 350








    Next i
[COLOR=#ff0000]chartNum = 0[/COLOR]
next




Set activeSlide = Nothing
Set newPowerPoint = Nothing
Set pptPres = Nothing








End Sub
 
Upvote 0
Still the same unfortunately.

It's annoying since It's very close to what I want, but it just doesn't seen to go past to the next chart :(

Thanks!
 
Upvote 0
You must log in or register to reply here.

Similar threads

B
  • Question Question
Export to PowerPOint using Excel VBA
Replies
0
Views
962
bronc
B
F
  • Question Question
Excel VBA to Powerpoint - paste special chart object link
Replies
3
Views
2K
Domenic
D
S
  • Question Question
VBA code for Excel tables into ppt - automation
Replies
3
Views
3K
Trebor76
T
C
  • Question Question
Replacing PowerPoint Input using Find and Replace Arrays from Excel through VBA
Replies
0
Views
2K
ckcs
C
Johnny C
  • Question Question
How do I return focus to Excel after copy to Powerpoint?
Replies
1
Views
2K
Johnny C
Johnny C

Forum statistics

Threads
1,223,911
Messages
6,175,323
Members
452,635
Latest member
laura12345

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top