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
'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