mardi 14 juin 2016

Excel VBA - Mouse-click Events on Charts crashes Excel

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