Event when chart/shape object delete

[DarrenW]

Hi all,

I am trying to fire an event when a shape object - particularly a chartobject - is deleted.

Using shape .OnAction property only fires when I click the object :/

Any thoughts, methods or code appreciated.


(Kind of cross-posted here Is there anything equivalent to the Visio BeforeDeleteShape in Excel? with no responses.)

Thank you,
D.

 

[DarrenW]

OK, thought about it further. FWIW this is the closest I can get.

On the worksheet with the embedded charts:

Option Explicit
Dim m_oCollectionOfEventHandlers As Collection

Private Sub Worksheet_Activate()
Dim oChartObject As ChartObject
Dim oEventHandler As clsChartEvents
Set m_oCollectionOfEventHandlers = New Collection
For Each oChartObject In ChartObjects
    Set oEventHandler = New clsChartEvents
    Set oEventHandler.Chart = oChartObject.Chart
    m_oCollectionOfEventHandlers.Add oEventHandler
Next oChartObject
End Sub

In ClassModule clsChartEvents:

Private WithEvents m_oChart As Chart

Dim ChartObjectCount As Long

Public Property Set Chart(ByVal oChart As Chart)
    Set m_oChart = oChart
End Property

Private Sub m_oChart_Activate()
    ChartObjectCount = Sheets(m_oChart.Parent.Parent.Name).ChartObjects.Count
End Sub

Private Sub m_oChart_Deactivate()
If Sheets(m_oChart.Parent.Parent.Name).ChartObjects.Count < ChartObjectCount Then
    MsgBox "Chart Deleted"
    'Some code here for the action to take
End If
End Sub

It's far from infallible, so if anyone has any suggestions for a better way of raising an event on deletion of an embedded chart I'd be obliged.

Thanks,
D.

 

[NdNoviceHlp]

Could you add the why? Maybe there's an alternate route. I messed around with sheet and wb code and it seems more difficult than I had imagined. I used the below code just to see if I could get the code to fire on chart deletion. No luck anywhere... and I guess hence your post. Sometimes you can avoid the hard stuff just by changing your approach. Good luck with this. Dave

MsgBox Sheets("sheet1").Shapes.Count

 

[DarrenW]

Could you add the why? Maybe there's an alternate route. I messed around with sheet and wb code and it seems more difficult than I had imagined. I used the below code just to see if I could get the code to fire on chart deletion. No luck anywhere... and I guess hence your post. Sometimes you can avoid the hard stuff just by changing your approach. Good luck with this. Dave

MsgBox Sheets("sheet1").Shapes.Count

Good thought & thank you

There is a modeless UserForm loaded that tracks information/provides data about and to charts in the workbook. I'm looking for a way to keep the UserForm uptodate when someone deletes a chart directly from a worksheet.

There is a listbox on the userform that maintains a list of all charts (chartobjects) - I slightly altered the code above so that the class module 1) checks if the userform is loaded and 2) if the UserForm is loaded, compare numbers (listcount vs chartobject count) on the chart deactivate event. It all comes apart if the user uses right-click cut or undoes the delete (as the undeleted (new) chart is not/no longer a part of the event handling collection).

Unfortunately for me, there are forces that are very against making the form modal, removing the delete key or right-click cut function.

 

[NdNoviceHlp]

This code seems to keep the userform listbox up to date. It uses the userform events available rather than a chart deletion event. HTH. Dave

Dim TotChrt As Integer
Private Sub UserForm_Initialize()
Dim cnt As Integer
TotChrt = Sheets("sheet1").ChartObjects.Count
For cnt = 1 To Sheets("sheet1").ChartObjects.Count
UserForm1.ListBox1.AddItem Sheets("sheet1").ChartObjects(cnt).Name
Next cnt
End Sub

Private Sub UserForm_Click()
Dim cnt As Integer
If TotChrt <> Sheets("sheet1").ChartObjects.Count Then
TotChrt = Sheets("sheet1").ChartObjects.Count
UserForm1.ListBox1.Clear
For cnt = 1 To Sheets("sheet1").ChartObjects.Count
UserForm1.ListBox1.AddItem Sheets("sheet1").ChartObjects(cnt).Name
Next cnt
End If
End Sub

Private Sub ListBox1_MouseMove(ByVal Button As Integer, _
  ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
Dim cnt As Integer
If TotChrt <> Sheets("sheet1").ChartObjects.Count Then
TotChrt = Sheets("sheet1").ChartObjects.Count
UserForm1.ListBox1.Clear
For cnt = 1 To Sheets("sheet1").ChartObjects.Count
UserForm1.ListBox1.AddItem Sheets("sheet1").ChartObjects(cnt).Name
Next cnt
End If
End Sub