Getting the chart coordinates by mouse-click in Excel/VBA

736 Views Asked by At

I am using the following code to get the coordinates on the mouse pointer on a XY-scatter plot. However I needed to manually tweak an offset parameter (CHPIXOFFSET) to get the coordinates corrent, and despite so, the coordinates are slightly wrong if you zoom out on the worksheet. Why doesn't ".PlotArea.InsideLeft" and ".PlotArea.InsideTop" give the true distance from chart edge to inside of plotarea? Is there some other parameter that might help out here?

Usage:

  1. Create a chart
  2. Call function AddChartEvents on the Chart object.
  3. Select chart and move mouse over it (or click mouse). Coordinates are reported in the status bar.

Code of Class Module "clsChareEvent":

Option Explicit

Public WithEvents ChartWithEvents As Excel.Chart
Const CHPIXOFFSET = 4


Private Sub ChartWithEvents_MouseMove(ByVal Button As Long, ByVal Shift As Long, ByVal x As Long, ByVal y As Long)
    Dim new_x As Double, new_y As Double
    new_x = x: new_y = y
    
    ConvertToChartXY ChartWithEvents, new_x, new_y
    
    ChartMove ChartWithEvents, new_x, new_y
End Sub

Private Sub ChartWithEvents_MouseDown(ByVal Button As Long, ByVal Shift As Long, ByVal x As Long, ByVal y As Long)
    Dim new_x As Double, new_y As Double
    new_x = x: new_y = y
    
    ConvertToChartXY ChartWithEvents, new_x, new_y
    ChartClick ChartWithEvents, new_x, new_y
End Sub

Private Sub ConvertToChartXY(oChrt As Excel.Chart, ByRef x As Double, ByRef y As Double)
    Dim dzoom As Double, dpixelsize As Double

    dzoom = ActiveWindow.Zoom / 100
    dpixelsize = PointsPerPixel()
    
    With oChrt
        
        x = .Axes(xlCategory).MinimumScale + (.Axes(xlCategory).MaximumScale - .Axes(xlCategory).MinimumScale) * _
                (x * dpixelsize / dzoom - CHPIXOFFSET - (.PlotArea.InsideLeft)) / .PlotArea.InsideWidth
            
        y = .Axes(xlValue).MinimumScale + (.Axes(xlValue).MaximumScale - .Axes(xlValue).MinimumScale) * _
                (1 - (y * dpixelsize / dzoom - CHPIXOFFSET - (.PlotArea.InsideTop)) / .PlotArea.InsideHeight)
    End With
End Sub

Code in normal module:

Option Explicit

Private Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function GetDeviceCaps Lib "gdi32" (ByVal hDC As Long, ByVal nIndex As Long) As Long
Private Declare Function ReleaseDC Lib "user32" (ByVal hwnd As Long, ByVal hDC As Long) As Long

Private Const LOGPIXELSX = 88               'Pixels/inch in X
Private Const POINTS_PER_INCH As Long = 72  'A point is defined as 1/72 inches

Public ChartEvents() As clsChartEvent

Public Function PointsPerPixel() As Double 'The size of a pixel, in points
    Dim hDC As Long, lDotsPerInch As Long
    hDC = GetDC(0)
    lDotsPerInch = GetDeviceCaps(hDC, LOGPIXELSX)
    PointsPerPixel = POINTS_PER_INCH / lDotsPerInch
    ReleaseDC 0, hDC
End Function

Public Sub AddChartEvents(oChrt As Excel.Chart)
    Dim i As Long
    If (Not Not ChartEvents) = 0 Then
        ReDim ChartEvents(0)
    Else
        For i = 0 To UBound(ChartEvents)
            If ChartEvents(i).ChartWithEvents Is oChrt Then Exit Sub 'Events already present
        Next
        ReDim Preserve ChartEvents(UBound(ChartEvents) + 1)
    End If
    Set ChartEvents(UBound(ChartEvents)) = New clsChartEvent
    Set ChartEvents(UBound(ChartEvents)).ChartWithEvents = oChrt
End Sub

Public Sub ChartClick(oChrt As Excel.Chart, x As Double, y As Double)
    Application.StatusBar = "User clicked chart at x=" & x & ", y=" & y
End Sub
Public Sub ChartMove(oChrt As Excel.Chart, x As Double, y As Double)
    Application.StatusBar = "MousePos (chart " & oChrt.Name & ") x=" & x & " , y=" & y
End Sub

0

There are 0 best solutions below