Trouble deleting only freeform shapes in excel chart using VBA and not the chart.

[MarkSELA]

With help from Peltier.com I've put together a sub which shades under two excel scatter plots using freeform shapes and filling the shapes. The sub then copies the chart and the 2 associated shapes to be used in a word document. I would the sub to delete the shapes and leave the chart so that it can be used again. That is what I am having trouble doing. The sheet I am using already has data and a scatter plot, so that the sub must only select active chart.

Sub TraceXYMulti()

      Dim myCht As Chart
      Dim mySrs As Series, Isrs As Integer
      Dim Npts As Integer, Ipts As Integer
      Dim myBuilder As FreeformBuilder
      Dim myShape As Shape
      Dim myShape1 As Shape
      Dim myShape2 As Shape
      Dim Xnode As Double, Ynode As Double
      Dim Xmin As Double, Xmax As Double
      Dim Ymin As Double, Ymax As Double
      Dim Xleft As Double, Ytop As Double
      Dim Xwidth As Double, Yheight As Double
      Dim Color As Integer
      Dim ws As Worksheet
      Dim i As Integer
      
        Worksheets("Sheet1").ChartObjects(1).Activate
        Set ws = Sheets("Sheet1")
        Set myCht = ActiveChart
        
        Xleft = myCht.PlotArea.InsideLeft
        Xwidth = myCht.PlotArea.InsideWidth
        Ytop = myCht.PlotArea.InsideTop
        Yheight = myCht.PlotArea.InsideHeight
        Xmin = myCht.Axes(1).MinimumScale
        Xmax = myCht.Axes(1).MaximumScale
        Ymin = myCht.Axes(2).MinimumScale
        Ymax = myCht.Axes(2).MaximumScale
        Color = 13
        i = 1
        
          For Isrs = 1 To myCht.SeriesCollection.Count
    
                Set mySrs = myCht.SeriesCollection(Isrs)
                Npts = mySrs.Points.Count
        
    'First point -------------------------------------------------------------------------------
                        Xnode = Xleft + (mySrs.XValues(1) - Xmin) * Xwidth / (Xmax - Xmin)
                        Ynode = Ytop + (Ymax - mySrs.Values(1)) * Yheight / (Ymax - Ymin)
                        Set myBuilder = myCht.Shapes.BuildFreeform(msoEditingAuto, Xnode, Ynode)
                
    'Remaining points ---------------------------------------------------------------------------
                        For Ipts = 2 To Npts
                          Xnode = Xleft + (mySrs.XValues(Ipts) - Xmin) * Xwidth / (Xmax - Xmin)
                          Ynode = Ytop + (Ymax - mySrs.Values(Ipts)) * Yheight / (Ymax - Ymin)
                          myBuilder.AddNodes msoSegmentLine, msoEditingAuto, Xnode, Ynode
                        Next
        
                Xnode = Xleft + (mySrs.XValues(Npts) - Xmin) * Xwidth / (Xmax - Xmin)
                Ynode = Ytop + Yheight
                myBuilder.AddNodes msoSegmentLine, msoEditingAuto, Xnode, Ynode
            
                Xnode = Xleft + (mySrs.XValues(1) - Xmin) * Xwidth / (Xmax - Xmin)
                Ynode = Ytop + Yheight
                myBuilder.AddNodes msoSegmentLine, msoEditingAuto, Xnode, Ynode
        
                Set myShape = myBuilder.ConvertToShape
                myShape.Name = "Shape" & Isrs
                
     'Shades the current polygon. ----------------------------------------------------------------------
     'The initial Color is set at yellow (13) and then increments to pink (14).-------------------------
     
                With myShape
                  .Line.ForeColor.SchemeColor = Isrs Mod 6
                  .Fill.ForeColor.SchemeColor = Color
                  .Fill.Transparency = 0.8
                  .Line.Visible = False
                End With
                
                Color = Color + 1
          Next
          
     'Copy the active chart. --------------------------------------------------------------------------
     'Then delete each shape in order to be ready to do it again. -------------------------------------
     
          Worksheets("Sheet1").ChartObjects("MainChart").CopyPicture xlScreen, xlPicture
             
        RemoveAutoShapesFromChart Worksheets("Sheet1").ChartObjects("MainChart").Chart
        
    End Sub

 

[NdNoviceHlp]

You're missing the "RemoveAutoShapesFromChart" sub. Perhaps it exists at Peltier.com? Dave

 

[MarkSELA]

You're missing the "RemoveAutoShapesFromChart" sub. Perhaps it exists at Peltier.com? Dave

Thanks.

 

[NdNoviceHlp]

You're welcome. I couldn't find the sub at Jon's site. Here's some code to remove the shapes from your chart. HTH. Dave

Dim shp As Shape
For Each shp In Sheets("Sheet1").ChartObjects("MainChart").Chart.Shapes
 shp.Delete
Next shp

 

[MarkSELA]

Thanks very much. I have decided to change tactics and now use VBA to control gnuplot which will create the shaded graphs I need. I should mark this solved. Thank you very much.

 

[NdNoviceHlp]

You are welcome. Thanks for posting your outcome. Dave