Excel Chart Crosshair Cursor,

BRAINTEASER

There is no problem with the code

Just wanted to know whether it can be made more efficient? Any advice?

I am trying to make a crosshair cursor for excel chartsheet. I have referred to many webpages such as Calculating datapoint position with chart mouseover event

Everyone concerned faced the same problem as I did - Calulation of exact cursor position coordinates as the chart is measured in points and cursor position (windows item) is measured in pixels. Somehow, I could calculate it with formula. (Very Close)

File can be downloaded from https://1drv.ms/u/s!AsuW6BrzIqXQhh_F9mCrENWGvKjK?e=iqP7hJ

Please note that page margins are set to zero

YouTube link https://www.youtube.com/watch?v=V0f-WGwd0_s

I understood cursor position coordinates are determined by following factors.

1. Windows Zoom set by "Make everything bigger" option in control panel/ settings. In Excel this can be determined using (ActiveWindow.Width)
2. Page Size of the Chartsheet (ActiveChart.PageSetup.PaperSize)
3. Page Orientation of the Chartsheet(ActiveChart.PageSetup.Orientation )
4. Zoom percent of the chartsheet (ActiveWindow.Zoom)
5. Chart area size (ChartArea.Width and ChartArea.Height)

Following is the code

Option Explicit

Private Sub Chart_MouseMove(ByVal Button As Long, ByVal Shift As Long, ByVal A As Long, ByVal B As Long)
' Instead of moving a line to a new cursor position, this macro deletes all the earlier lines and creates new lines on the new cursor position
' This deletion and addition of lines makes this macro inefficient causing a fraction of second lag.

Dim xPoint As Variant, yPoint As Variant, XMax As Variant, YMax As Variant, DispScale As Variant
Dim shp As Shape
Dim ChartPaperSize, PgWidPXL, PgHgtPXL, ChtAreaWid, ChtAreaHgt, ActWinZoom

'OK.. I have removed following lines deleting earlier lines. 'Also, I have removed code at the bottom for adding new lines. 'Instead, now I have added code at the bottom changing the attributes of the 'present lines for their placement 'First delete all the line shapes added 'For Each shp In ActiveChart.Shapes 'If Not shp.Type = msoFormControl Then shp.Delete 'Next shp

'This macro is suitable for following 4 paper sizes only
'MsgBox ("Please set Chart Paper Size to Legal, Letter, A4 or A3")

'Debug.Print A & ""& B

ChartPaperSize = ActiveChart.PageSetup.PaperSize
Select Case ChartPaperSize
' I couldnt find better way to convert paper size number to inches and therafter to pixels
' I dont know why multiplying by 0.9745 or 0.9725 keeps the x, y coordinates more close to the diplayed cursor position
    Case 5 '"xlPaperLegal"
       If ActiveChart.PageSetup.Orientation = xlLandscape Then
       PgWidPXL = 14 * 220 * 0.9745 '220 PPI
       PgHgtPXL = 8.5 * 220 * 0.9725
       Else
       PgWidPXL = 8.5 * 220 * 0.9745
       PgHgtPXL = 14 * 220 * 0.9725
       End If
    Case 1 '"xlPaperLetter"
       If ActiveChart.PageSetup.Orientation = xlLandscape Then
       PgWidPXL = 11 * 220 * 0.9745
       PgHgtPXL = 8.5 * 220 * 0.9725
       Else
       PgWidPXL = 8.5 * 220 * 0.9745
       PgHgtPXL = 11 * 220 * 0.9725
       End If
    Case 9 '"xlPaperA4"
       If ActiveChart.PageSetup.Orientation = xlLandscape Then
       PgWidPXL = 11.69 * 220 * 0.9745
       PgHgtPXL = 8.27 * 220 * 0.9725
       Else
       PgWidPXL = 8.27 * 220 * 0.9745
       PgHgtPXL = 11.69 * 220 * 0.9725
       End If
    Case 8 '"xlPaperA3"
       If ActiveChart.PageSetup.Orientation = xlLandscape Then
       PgWidPXL = 16.54 * 220 * 0.9745
       PgHgtPXL = 11.69 * 220 * 0.9725
       Else
       PgWidPXL = 11.69 * 220 * 0.9745
       PgHgtPXL = 16.54 * 220 * 0.9725
       End If
    'Case Else
    'End Sub
End Select

'If UserForm2.CommandButton10.BackColor = vbGreen Then

XMax = PgWidPXL * (100 / 125) ' for A4 2503 for legal 2999 '2395 'Max mousepointer width on 100% chart sheet zoom
YMax = PgHgtPXL * (100 / 125) ' for A4 1764 for legal 1814 '1450 ''Max mousepointer height on 100% chart sheet zoom

ChtAreaWid = ChartArea.Width
ChtAreaHgt = ChartArea.Height

DispScale = Round(1161 / ActiveWindow.Width, 2)
' 1161 is ActiveWindow.Width at Windows display recommended scale of 125%

ActWinZoom = ActiveWindow.Zoom

xPoint = (A * (ChtAreaWid * DispScale) / XMax) / (ActWinZoom / 100)
yPoint = (B * (ChtAreaHgt * DispScale) / YMax) / (ActWinZoom / 100)

'following code deleted 'With ActiveChart.Shapes.AddLine(1, yPoint, ChartArea.Width, yPoint).Line '.ForeColor.RGB = RGB(0, 0, 0) 'End With 'With ActiveChart.Shapes.AddLine(xPoint, 1, xPoint, ChartArea.Height).Line '.ForeColor.RGB = RGB(0, 0, 0) 'End With 'following new code added

With ActiveChart.Shapes(1) ' horizontal line
.Left = 1
.Top = yPoint
.Width = ChartArea.Width
.Height = 1
End With

With ActiveChart.Shapes(2) 'vertical line
.Top = 1
.Left = xPoint
.Height = ChartArea.Height
.Width = 1
End With



'End If

End Sub

Excel file at the link is replaced with the modified file.