Copying Excel charts into PowerPoint

K

kd4dna

New Member
Joined
Jan 12, 2009
Messages
25
I have built a macro that creates several charts from data in one worksheet. Once the char is created it makes it it's own sheet. I now want to take those charts and put it into a new PowerPoint Presentation. The code below works for the 1st chart but when I run it for the second chart I get an error of

'Run-time error '-2147188160(80048240)';
ShapeRange(unknown member): invalid request. To select a shape, its value must be active.

my code that builds the chart is below:

Dim ppApp As PowerPoint.Application
Set ppApp = CreateObject("Powerpoint.Application")

' Make it visible.
ppApp.Visible = True

' Add a new presentation.
Dim ppPres As PowerPoint.Presentation
Set ppPres = ppApp.Presentations.Add(msoTrue)

' Add a new slide.
Dim ppSlide1 As PowerPoint.Slide
Set ppSlide1 = ppPres.Slides.Add(1, ppLayoutText)

ActiveSheet.Shapes.AddChart.Select
With ActiveChart
.SetSourceData Source:=Range("Temp")
.ChartType = chtTemp
.HasTitle = True
.ChartTitle.Text = "Temperature F"
.SetElement (msoElementPrimaryValueAxisTitleRotated)
.Axes(xlValue).AxisTitle.Caption = "Degrees F"
.SeriesCollection(3).Select
.SeriesCollection(3).Delete
.SeriesCollection(1).Name = "=""Extreme Max"""
.SeriesCollection(1).XValues = Range("XValues")
.ApplyDataLabels (xlDataLabelsShowValue)
.SeriesCollection(2).Name = "=""Mean Max"""
.SeriesCollection(3).Name = "=""Mean Min"""
.SeriesCollection(4).Name = "=""Extreme Min"""
.Location Where:=xlLocationAsNewSheet, Name:="Temperature"
End With

Charts("Temperature").CopyPicture Appearance:=xlScreen, Format:=xlPicture

ppSlide1.Shapes.Paste.Select

ppApp.ActiveWindow.Selection.ShapeRange.Align msoAlignCenters, True
ppApp.ActiveWindow.Selection.ShapeRange.Align msoAlignMiddles, True
ppApp.ActiveWindow.Selection.ShapeRange.ScaleHeight 0.75, msoTrue, msoScaleFromMiddle
ppApp.ActiveWindow.Selection.ShapeRange.ScaleWidth 0.75, msoTrue, msoScaleFromMiddle

ppSlide1.Shapes(1).TextFrame.TextRange.Text = Station
ppSlide1.Shapes(1).TextFrame.TextRange.Font.Size = 20

Dim ppSlide2 As PowerPoint.Slide
Set ppSlide2 = ppPres.Slides.Add(2, ppLayoutText)


Sheets("Data").Activate
ActiveSheet.Shapes.AddChart.Select
With ActiveChart
.ChartType = chtPcpn
.SetSourceData Source:=Range("Precip")
.HasTitle = True
.ChartTitle.Text = "Precipitation"
.SetElement (msoElementPrimaryValueAxisTitleRotated)
.Axes(xlValue).AxisTitle.Caption = "Inches"
.SeriesCollection(1).Name = "=""Maximum"""
.SeriesCollection(1).Interior.Color = RGB(255, 0, 0)
.SeriesCollection(2).Name = "=""Mean"""
.SeriesCollection(2).Interior.Color = RGB(0, 255, 0)
.SeriesCollection(3).Name = "=""Minimum"""
.SeriesCollection(3).Interior.Color = RGB(204, 102, 0)
.SeriesCollection(4).Name = "=""Max 24 HR"""
.SeriesCollection(4).Interior.Color = RGB(31, 73, 123)
.SeriesCollection(1).XValues = Range("XValues")
.ApplyDataLabels (xlDataLabelsShowValue)
.Location Where:=xlLocationAsNewSheet, Name:="Precipitation"
End With
Charts("Precipitation").CopyPicture Appearance:=xlScreen, Format:=xlPicture

ppSlide2.Shapes.Paste.Select 'This is the line where the code hangs

ppApp.ActiveWindow.Selection.ShapeRange.Align msoAlignCenters, True
ppApp.ActiveWindow.Selection.ShapeRange.Align msoAlignMiddles, True
ppApp.ActiveWindow.Selection.ShapeRange.ScaleHeight 0.75, msoTrue, msoScaleFromMiddle
ppApp.ActiveWindow.Selection.ShapeRange.ScaleWidth 0.75, msoTrue, msoScaleFromMiddle
ppSlide2.Shapes(1).TextFrame.TextRange.Text = Station
ppSlide2.Shapes(1).TextFrame.TextRange.Font.Size = 20

I'm not sure why the 2nd chart is not selected when it pastes into PowerPoint. When I look at the powerpoint the 1st chart (Temperature) is still selected.
Eventually I want to copy 6 charts to slides.

Any ideas would be greatly appreciated.


Thanks,

Ron, kd4dna@charter.net
 

Excel Facts

Format cells as date
Select range and press Ctrl+Shift+3 to format cells as date. (Shift 3 is the # sign which sort of looks like a small calendar).
Sort by date Sort by votes
I actually solved my problem today with a few lines of code in the proper syntax.

Thanks,

Ron
 
Upvote 0
Hi, interesting post!

Do you mind posting the solution, I'm kind of where you were :)

Regards
Beenman
 
Upvote 0
Don't lknow if this will help you out much but here is what I did.

In another Sub I load ASCII Text data into a sheet which has the data for the charts. The Sheet name is DATA

Code: 
Sub MakeCharts()
'Create the chart sheets for Temperature, Precip, Snow, RH, Wind, WX
'Each chart has different parameters and series so I had to use a different With ActiveChart to set those parameters

Dim ppSlide As PowerPoint.Slide
Dim SlideCount As Long
 
'Open Powerpoint
    Dim ppApp As PowerPoint.Application
    Set ppApp = CreateObject("Powerpoint.Application")
 
    ' Make it visible.
    ppApp.Visible = True
 
    ' Add a new presentation.
    Dim ppPres As PowerPoint.Presentation
    Set ppPres = ppApp.Presentations.Add(msoTrue)
 
    ' Add a new slide.
    Dim ppSlide1 As PowerPoint.Slide
    Set ppSlide1 = ppPres.Slides.Add(1, ppLayoutText)
 
Sheets("Data").Activate
    'Make the chart
    ActiveSheet.Shapes.AddChart.Select
With ActiveChart
    .SetSourceData Source:=Range("Temp")
    .ChartType = chtTemp
    .HasTitle = True
    .ChartTitle.Text = "Temperature F"
    .SetElement (msoElementPrimaryValueAxisTitleRotated)
    .Axes(xlValue).AxisTitle.Caption = "Degrees F"
    .SeriesCollection(3).Select
    .SeriesCollection(3).Delete
    .SeriesCollection(1).Name = "=""Extreme Max"""
    .SeriesCollection(1).XValues = Range("XValues")
    .ApplyDataLabels (xlDataLabelsShowValue)
    .SeriesCollection(2).Name = "=""Mean Max"""
    .SeriesCollection(3).Name = "=""Mean Min"""
    .SeriesCollection(4).Name = "=""Extreme Min"""
    .Location Where:=xlLocationAsNewSheet, Name:="Temperature"
End With
 
'Copy the chart I just made
Charts("Temperature").CopyPicture Appearance:=xlScreen, Format:=xlPicture
    ppSlide1.Shapes.Paste.Select
   
'this aligns the chart on the slide
    ppApp.ActiveWindow.Selection.ShapeRange.Align msoAlignCenters, True
    ppApp.ActiveWindow.Selection.ShapeRange.Align msoAlignMiddles, True
    ppApp.ActiveWindow.Selection.ShapeRange.ScaleHeight 0.7, msoTrue, msoScaleFromMiddle
    ppApp.ActiveWindow.Selection.ShapeRange.ScaleWidth 0.7, msoTrue, msoScaleFromMiddle
    
    ppSlide1.Shapes(1).TextFrame.TextRange.Text = Station
    ppSlide1.Shapes(1).TextFrame.TextRange.Font.Size = 20
    
    'Make the the next chart
    Sheets("Data").Activate
    ActiveSheet.Shapes.AddChart.Select
With ActiveChart
    .ChartType = chtPcpn
    .SetSourceData Source:=Range("Precip")
    .HasTitle = True
    .ChartTitle.Text = "Precipitation"
    .SetElement (msoElementPrimaryValueAxisTitleRotated)
    .Axes(xlValue).AxisTitle.Caption = "Inches"
    .SeriesCollection(1).Name = "=""Maximum"""
    .SeriesCollection(1).Interior.Color = RGB(255, 0, 0)
    .SeriesCollection(2).Name = "=""Mean"""
    .SeriesCollection(2).Interior.Color = RGB(0, 255, 0)
    .SeriesCollection(3).Name = "=""Minimum"""
    .SeriesCollection(3).Interior.Color = RGB(204, 102, 0)
    .SeriesCollection(4).Name = "=""Max 24 HR"""
    .SeriesCollection(4).Interior.Color = RGB(31, 73, 123)
    .SeriesCollection(1).XValues = Range("XValues")
    .ApplyDataLabels (xlDataLabelsShowValue)
    .Location Where:=xlLocationAsNewSheet, Name:="Precipitation"
End With
'...and on and on until all my charts are made
Charts("Precipitation").CopyPicture Appearance:=xlScreen, Format:=xlPicture
' Add a new slide and paste in the chart
SlideCount = ppPres.Slides.count
Set ppSlide = ppPres.Slides.Add(SlideCount + 1, ppLayoutText)
ppApp.ActiveWindow.View.GotoSlide ppSlide.SlideIndex
With ppSlide
    .Shapes.Paste.Select ' paste and select the chart picture
    .Shapes(1).TextFrame.TextRange.Text = Station
    .Shapes(1).TextFrame.TextRange.Font.Size = 20
' align the chart
    ppApp.ActiveWindow.Selection.ShapeRange.Align msoAlignCenters, True
    ppApp.ActiveWindow.Selection.ShapeRange.Align msoAlignMiddles, True
    ppApp.ActiveWindow.Selection.ShapeRange.ScaleHeight 0.7, msoTrue, msoScaleFromMiddle
    ppApp.ActiveWindow.Selection.ShapeRange.ScaleWidth 0.7, msoTrue, msoScaleFromMiddle
    
End With
'
    Sheets("Data").Activate
    ActiveSheet.Shapes.AddChart.Select
With ActiveChart
    .ChartType = chtSno
    .SetSourceData Source:=Range("Snowfall")
    .HasTitle = True
    .ChartTitle.Text = "Snowfall"
    .SetElement (msoElementPrimaryValueAxisTitleRotated)
    .Axes(xlValue).AxisTitle.Caption = "Inches"
    .SeriesCollection(1).Name = "=""Mean"""
    .SeriesCollection(2).Name = "=""Maximum"""
    .SeriesCollection(3).Name = "=""Max 24 HR"""
    .SeriesCollection(1).XValues = Range("XValues")
    .ApplyDataLabels (xlDataLabelsShowValue)
    .Location Where:=xlLocationAsNewSheet, Name:="Snowfall"
End With
Charts("Snowfall").CopyPicture Appearance:=xlScreen, Format:=xlPicture
Set ppSlide = ppPres.Slides.Add(SlideCount + 1, ppLayoutText)
ppApp.ActiveWindow.View.GotoSlide ppSlide.SlideIndex
With ppSlide
    .Shapes.Paste.Select ' paste and select the chart picture
    .Shapes(1).TextFrame.TextRange.Text = Station
    .Shapes(1).TextFrame.TextRange.Font.Size = 20
' align the chart
    ppApp.ActiveWindow.Selection.ShapeRange.Align msoAlignCenters, True
    ppApp.ActiveWindow.Selection.ShapeRange.Align msoAlignMiddles, True
    ppApp.ActiveWindow.Selection.ShapeRange.ScaleHeight 0.7, msoTrue, msoScaleFromMiddle
    ppApp.ActiveWindow.Selection.ShapeRange.ScaleWidth 0.7, msoTrue, msoScaleFromMiddle
    
End With
    Sheets("Data").Activate
    ActiveSheet.Shapes.AddChart.Select
With ActiveChart
    .ChartType = chtRh
    .SetSourceData Source:=Range("RH")
    .HasTitle = True
    .ChartTitle.Text = "Relitive Humidity"
    .SetElement (msoElementPrimaryValueAxisTitleRotated)
    .Axes(xlValue).AxisTitle.Caption = "Percent"
    .SeriesCollection(1).Name = "=""0600L"""
    .SeriesCollection(2).Name = "=""1200L"""
    .SeriesCollection(1).XValues = Range("XValues")
    .ApplyDataLabels (xlDataLabelsShowValue)
    .Location Where:=xlLocationAsNewSheet, Name:="Relative Humidity"
End With
Charts("Relative Humidity").CopyPicture Appearance:=xlScreen, Format:=xlPicture
Set ppSlide = ppPres.Slides.Add(SlideCount + 1, ppLayoutText)
ppApp.ActiveWindow.View.GotoSlide ppSlide.SlideIndex
With ppSlide
    .Shapes.Paste.Select ' paste and select the chart picture
    .Shapes(1).TextFrame.TextRange.Text = Station
    .Shapes(1).TextFrame.TextRange.Font.Size = 20
' align the chart
    ppApp.ActiveWindow.Selection.ShapeRange.Align msoAlignCenters, True
    ppApp.ActiveWindow.Selection.ShapeRange.Align msoAlignMiddles, True
    ppApp.ActiveWindow.Selection.ShapeRange.ScaleHeight 0.7, msoTrue, msoScaleFromMiddle
    ppApp.ActiveWindow.Selection.ShapeRange.ScaleWidth 0.7, msoTrue, msoScaleFromMiddle
    
End With

    Sheets("Data").Activate
    ActiveSheet.Shapes.AddChart.Select
With ActiveChart
    .ChartType = chtWnd
    .SetSourceData Source:=Range("Winds")
    .HasTitle = True
    .ChartTitle.Text = "Winds"
    .SetElement (msoElementPrimaryValueAxisTitleRotated)
    .Axes(xlValue).AxisTitle.Caption = "Knots"
    .SeriesCollection(2).Select
    .SeriesCollection(2).Delete
    .SeriesCollection(2).Select
    .SeriesCollection(2).Delete
    .SeriesCollection(1).Name = "=""Mean Speed"""
    .SeriesCollection(2).Name = "=""Peak Gust"""
    .SeriesCollection(1).XValues = Range("XValues")
    .ApplyDataLabels (xlDataLabelsShowValue)
    .Location Where:=xlLocationAsNewSheet, Name:="Winds"
End With
Charts("Winds").CopyPicture Appearance:=xlScreen, Format:=xlPicture
Set ppSlide = ppPres.Slides.Add(SlideCount + 1, ppLayoutText)
ppApp.ActiveWindow.View.GotoSlide ppSlide.SlideIndex
With ppSlide
    .Shapes.Paste.Select ' paste and select the chart picture
    .Shapes(1).TextFrame.TextRange.Text = Station
    .Shapes(1).TextFrame.TextRange.Font.Size = 20
' align the chart
    ppApp.ActiveWindow.Selection.ShapeRange.Align msoAlignCenters, True
    ppApp.ActiveWindow.Selection.ShapeRange.Align msoAlignMiddles, True
    ppApp.ActiveWindow.Selection.ShapeRange.ScaleHeight 0.7, msoTrue, msoScaleFromMiddle
    ppApp.ActiveWindow.Selection.ShapeRange.ScaleWidth 0.7, msoTrue, msoScaleFromMiddle
    
End With

    Sheets("Data").Activate
    ActiveSheet.Shapes.AddChart.Select
With ActiveChart
    .ChartType = chtWx
    .SetSourceData Source:=Range("WX")
    .HasTitle = True
    .ChartTitle.Text = "Weather"
    .SetElement (msoElementPrimaryValueAxisTitleRotated)
    .Axes(xlValue).AxisTitle.Caption = "# of Days/Month"
    .SeriesCollection(4).Name = "=""Blowing Dust"""
    .SeriesCollection(4).Interior.Color = RGB(204, 102, 0)
    .SeriesCollection(2).Name = "=""Fog"""
    .SeriesCollection(2).Interior.Color = RGB(255, 255, 0)
    .SeriesCollection(3).Name = "=""Thunderstorms"""
    .SeriesCollection(3).Interior.Color = RGB(255, 0, 0)
    .SeriesCollection(1).Name = "=""Cloud Cover /8ths"""
    .SeriesCollection(1).Interior.Color = RGB(31, 73, 123)
    .SeriesCollection(1).XValues = Range("XValues")
    .ApplyDataLabels (xlDataLabelsShowValue)
    .Location Where:=xlLocationAsNewSheet, Name:="Weather"
End With
Charts("Weather").CopyPicture Appearance:=xlScreen, Format:=xlPicture
Set ppSlide = ppPres.Slides.Add(SlideCount + 1, ppLayoutText)
ppApp.ActiveWindow.View.GotoSlide ppSlide.SlideIndex
With ppSlide
    .Shapes.Paste.Select ' paste and select the chart picture
    .Shapes(1).TextFrame.TextRange.Text = Station
    .Shapes(1).TextFrame.TextRange.Font.Size = 20
' align the chart
    ppApp.ActiveWindow.Selection.ShapeRange.Align msoAlignCenters, True
    ppApp.ActiveWindow.Selection.ShapeRange.Align msoAlignMiddles, True
    ppApp.ActiveWindow.Selection.ShapeRange.ScaleHeight 0.7, msoTrue, msoScaleFromMiddle
    ppApp.ActiveWindow.Selection.ShapeRange.ScaleWidth 0.7, msoTrue, msoScaleFromMiddle
    
End With

End Sub

Hope it helps, I'm still not finished with this. I'll get back around to working on it when things slow down a little at work.

Ron
KD4DNA
 
Upvote 0
You must log in or register to reply here.

Similar threads

F
  • Question
Excel VBA to Powerpoint - paste special chart object link
Replies
3
Views
965
Domenic
D
B
  • Question
Excel to PowerPoint - Was working, not generating error....
Replies
1
Views
689
BuJay
B
E
  • Question
Can anyone help me get my VBA code working? I have spent tons of time but can't quite fix it.
Replies
3
Views
2K
profray
P
O
  • Solved
Excel to PowerPoint VBA - Need help diagnosing and fixing error in code
2 3
Replies
22
Views
2K
Worf
Worf
A
  • Question
Help with existing code in Post - VBA to Create Org Chart
Replies
1
Views
2K
mrpotato562
M

Forum statistics

Threads
1,214,957
Messages
6,122,466
Members
449,086
Latest member
kwindels

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