如下图1所示，当鼠标在图表的绘图区移动时，Excel左下角的状态栏会显示鼠标所在位置的坐标值；当鼠标移动的同时按下Shift键时，图表中的椭圆形会跟随移动，且Excel左下角的状态栏会显示其所在位置的坐标值。
图1
打开VBE，插入一个标准模块，输入如下代码：
代码语言：javascript复制Option Private Module
' 在X中的像素/英寸
Private Const LOGPIXELSX = 88
'1磅定义为1/72英寸
Private Const POINTS_PER_INCH As Long = 72
''''''''''''''''''''''''''''''''''''''''''''''''''
' 函数声明
''''''''''''''''''''''''''''''''''''''''''''''''''
'获取窗口的设备上下文（绘图层）的句柄
Private Declare PtrSafe Function GetDC Lib "user32" (ByVal hWnd As Long) As Long
'从设备上下文中获取设备的功能
Private Declare PtrSafe Function GetDeviceCaps Lib "gdi32" (ByVal hDC As Long, ByVal nIndex As Long) As Long
'释放设备上下文的句柄，以进行整理
Private Declare PtrSafe Function ReleaseDC Lib "user32" (ByVal hWnd As Long, ByVal hDC As Long) As Long
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' 用途: 计算像素大小, 以磅为单位.
' 取决于用户的DPI设置
' 控制面板> 显示 > 设置> 高级 > 通用
' '正常'设置是96dpi, 其中1像素 =0.75 磅
' '大'设置是120dpi, 其中1像素 =0.8 磅
'
' 参数: 无
'
' 返回:Double 像素的大小,以磅为单位.
'
Public Function PointsPerPixel() As Double
Dim hDC As Long
Dim lDotsPerInch As Long
'获取桌面窗口设备上下文(例如, 屏幕)
hDC =GetDC(0)
'获取用户的DPI设置
lDotsPerInch = GetDeviceCaps(hDC, LOGPIXELSX)
'用每英寸72磅除以dpi得出像素的宽度
PointsPerPixel = POINTS_PER_INCH / lDotsPerInch
'释放设备上下文, 以进行整理
ReleaseDC 0, hDC
End Function插入一个类模块，将其名称修改为CChart，在其中输入下面的代码：
代码语言：javascript复制' 说明: 演示在不同的图表坐标系之间转换的类
'
' 模块级变量,勾挂图表的事件
Public WithEvents mchtChart As Chart
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' 用途: 当用户围绕图表移动鼠标时,
' 转换鼠标坐标为数据并绘制对象坐标,
' 更新状态栏且移动圆.
Private Sub mchtChart_MouseMove(ByVal Button AsLong, ByVal Shift As Long, ByVal X As Long, ByVal Y As Long)
Dim dZoom As Double
Dim dXVal As Double
Dim dYVal As Double
Dim dPixelSize As Double
On Error Resume Next
'活动窗口缩放系数
dZoom =ActiveWindow.Zoom / 100
'像素尺寸, 以磅为单位
dPixelSize = PointsPerPixel
'鼠标坐标到数据坐标
With mchtChart
dXVal= .Axes(xlCategory).MinimumScale (.Axes(xlCategory).MaximumScale -.Axes(xlCategory).MinimumScale) * (X * dPixelSize / dZoom -(.PlotArea.InsideLeft .ChartArea.Left)) / .PlotArea.InsideWidth
dYVal= .Axes(xlValue).MinimumScale (.Axes(xlValue).MaximumScale -.Axes(xlValue).MinimumScale) * (1 - (Y * dPixelSize / dZoom -(.PlotArea.InsideTop .ChartArea.Top)) / .PlotArea.InsideHeight)
End With
Application.StatusBar = "(" & Application.Round(dXVal, 2)& ", " & Application.Round(dYVal, 2) & ")"
'鼠标坐标到绘制图对象点.
'如果按下Shift键则移动绘制的对象
If Shift= 1 Then
With mchtChart
dXVal = (X * dPixelSize / dZoom - .ChartArea.Left)
dYVal = (Y * dPixelSize / dZoom - .ChartArea.Top)
With .Shapes("ovlPointer")
.Left = dXVal - .Width / 2
.Top = dYVal - .Height / 2
End With
End With
End If
End Sub最后，在ThisWorkbook代码模块中，输入下面的代码：
代码语言：javascript复制Dim mclsChart As CChart
'初始化图表事件句柄
Private Sub Workbook_Open()
Set mclsChart = New CChart
Set mclsChart.mchtChart = wksCoordinates.ChartObjects(1).Chart
End Sub关闭工作簿，重新打开，选择工作表中的图表，然后在绘图区移动鼠标或按住Shift键的同时移动鼠标，可以看到图1中的效果。
注：本示例整理自《Excel专业开发》，适用于64位版本的Excel，有兴趣的朋友可以学习参考。
