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:
- Create a chart
- Call function AddChartEvents on the Chart object.
- 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