I'm trying to enable mouse click events on an 2D scatter plot embedded in an Excel worksheet, such that the user can click a data point and have my software do stuff with the X, Y point selected. Usually this works just fine, but 1 in maybe 30 or so times the mouse-click will crash Excel with a "Microsoft Excel has stopped working" message.
The code I'm using (modified from original code I found at peltiertech.com) is divided into a class module shown below, then a regular code module. I create the scatter chart in the first place (either programmatically or via the normal excel method of adding a chart), embed it in a worksheet, populate a single series sourced from some sample X Y data columns on another worksheet, and then write the X-Y values for the point the user clicked to a pair of cells on the ActiveSheet with the chart.
I have not been able to figure out any real pattern to why it fails, other than that it seems to happen soon (within 10 mouse clicks) after opening a workbook, or it probably won't happen at all (not a hard and fast rule through, eventually it will crash). It seems unaffected by whether I click rapidly or pause between clicks. While viewing the stats in the task manager, I haven't noticed anything that would seem to correspond to a memory leak or anything too obvious.
The only clue I've found is that it seems like it only happens if I do some sort of cell formatting, which is why I put the otherwise pointless for-loop in the code below to format the floating point precision of the cell value I'm writing to. However it does not crash at that point in the code; by putting a msgbox right before the end of the event-handling function, I've confirmed the excel crash comes after the msgbox - in other words the code is crashing when it returns from this function to whatever native code excel is using to handle the mouse-click event. Also, I tried using MouseUp rather than MouseDown, and got the same error.
Class module: CChartEvent
Option Explicit
' Modified from original code at peltiertech.com
Public WithEvents EventChart As chart
Private Sub EventChart_MouseDown(ByVal Button As Long, _
ByVal Shift As Long, _
ByVal x As Long, _
ByVal y As Long)
Dim ElementID As Long, Arg1 As Long, Arg2 As Long
Dim myX As Variant, myY As Double
With ActiveChart
.GetChartElement x, y, ElementID, Arg1, Arg2
If ElementID = xlSeries Or ElementID = xlDataLabel Then
If Arg2 > 0 Then
' Extract x value from array of x values
myX = WorksheetFunction.index _
(.SeriesCollection(Arg1).XValues, Arg2)
' Extract y value from array of y values
myY = WorksheetFunction.index _
(.SeriesCollection(Arg1).Values, Arg2)
Dim i As Integer, dataSht As Worksheet
Set dataSht = Worksheets("plotpage")
dataSht.Range("R2").Value = myX
dataSht.Range("R3").Value = myY
' It seems like I only get the crash if I do some cell
' formatting, such as number formatting or changing the cell
' background color, so this for-loop is meant to do this a lot
' to try to trigger a crash
For i = 0 To 20
dataSht.Range("R2").NumberFormat = "0.0E+0"
dataSht.Range("R3").NumberFormat = "0.0E+0"
Next
End If
End If
End With
'msgBox ("This comment when enabled happens before the crash")
End Sub
Regular module: CLKCode Option Explicit ' Code comes from peltiertech.com
Dim clsChartEvent As New CChartEvent
Dim clsChartEvents() As New CChartEvent
Sub Set_All_Charts()
' Enable events for active sheet if sheet is a chart sheet
If TypeName(ActiveSheet) = "Chart" Then
Set clsChartEvent.EventChart = ActiveSheet
End If
' Enable events for all charts embedded on a sheet
' Works for embedded charts on a worksheet or chart sheet
If ActiveSheet.ChartObjects.Count > 0 Then
ReDim clsChartEvents(1 To ActiveSheet.ChartObjects.Count)
Dim chtObj As ChartObject
Dim chtnum As Integer
chtnum = 1
For Each chtObj In ActiveSheet.ChartObjects
' Debug.Print chtObj.Name, chtObj.Parent.Name
Set clsChartEvents(chtnum).EventChart = chtObj.chart
chtnum = chtnum + 1
Next ' chtObj
End If
End Sub
Sub Reset_All_Charts()
' Disable events for all charts previously enabled together
Dim chtnum As Integer
On Error Resume Next
Set clsChartEvent.EventChart = Nothing
For chtnum = 1 To UBound(clsChartEvents)
Set clsChartEvents(chtnum).EventChart = Nothing
Next ' chtnum
End Sub
I would greatly appreciate any help anyone can provide. For reference, I'm running Excel 2010 in Windows 7. I've done a fair amount of Excel VBA but this is my first exposure to event-handling and classes in VBA.
Aucun commentaire:
Enregistrer un commentaire