Hi,
OK, don't use a shape for your button. Go to the Developer tab > Insert > Form Control > Button. You can assign your macro to the new button. The selection will not change when you click the button.
But the second issue is that now you say you want to select multiple charts (by holding down Ctrl while clicking them). When you do that, you are actually selecting multiple Shape objects. So you would need to do something like:
Dim ppt As PowerPoint.ApplicationDim pptPres As PowerPoint.PresentationDim pptCL As PowerPoint.CustomLayout
Sub PushSelectedChartsToPpt()
' Add a reference to 'Microsoft PowerPoint xx.0 Object Library'' via VBE > Tools > References.' Dim shpRng As ShapeRange
Dim shp As Shape
On Error Resume Next
Set shpRng = Application.Selection.ShapeRange
On Error GoTo 0
If Not shpRng Is Nothing Then 'At least one shape is selected....
For Each shp In shpRng
If shp.HasChart Then
Call PushChartToPpt(shp.Chart.ChartArea)
End If
Next shp
shpRng.Select
ElseIf Not ActiveChart Is Nothing Then 'Only 1 Chart is selected...
Call PushChartToPpt(ActiveChart.ChartArea)
Else
MsgBox "Please select at least one chart before running this macro"
Exit Sub
End If
'Delete these last 3 lines if you want to add subsequent charts to the existing presentation... Set pptCL = Nothing
Set pptPres = Nothing
Set ppt = Nothing
End Sub
Sub PushChartToPpt(chtArea As ChartArea)
Dim pptSld As PowerPoint.Slide
Dim pptShp As PowerPoint.Shape
If ppt Is Nothing Or pptPres Is Nothing Or pptCL Is Nothing Then
'Get the PowerPoint Application object: Set ppt = CreateObject("PowerPoint.Application")
ppt.Visible = msoTrue
Set pptPres = ppt.Presentations.Add
'Get a Custom Layout: For Each pptCL In pptPres.SlideMaster.CustomLayouts
If pptCL.Name = "Title and Content" Then Exit For
Next pptCL
End If
'Get a slide: Set pptSld = pptPres.Slides.AddSlide(pptPres.Slides.Count + 1, pptCL)
pptSld.Select
'Get a Placeholder on the slide: For Each pptShp In pptSld.Shapes.Placeholders
If pptShp.PlaceholderFormat.Type = ppPlaceholderObject Then Exit For
Next pptShp
If pptShp Is Nothing Then Stop
'Copy the parsed ChartArea:
chtArea.Copy
'Paste into Ppt: ppt.Activate
pptPres.Windows(1).Activate
pptShp.Select
pptPres.Windows(1).View.Paste
End Sub
Hope that helps.
Cheers
Rich