Dear forumites
I have a path with xy coordinates that is expressed on an Excel chart. I want the user to be able to edit the path by repositioning points directly on the chart. The chart is on a chart sheet. The required methodology is as follows:
1) The user selects a point on the chart to be moved. This point is highlighted (made bigger in this case).
2) Any subsequesnt click in the chart area gets the coordiates of the click and changes the underlying data source.
3) As soon as the user clicks on a new point, the old point must be deselected, the new point becomes active and is now editable.
(Later on, the user must be able to insert or delete points, but first I must get the basics mastered.)
I've got it programmed and in a way it works, but:
• even if the user clicks on a new point to be selected, the old point is still moved. Somehow there are events firing when the new point is selected that I'm not manage to bypass.
• When a new point is selected, the user has to click on it twice. Not double click, but click for a second time. Again, the first click seems to be ineffectual, - because, I don't know, the chart area is selected with the fist click? - then the point is selected only on the second click.
I bypassed the problem by allowing point edits only with shift+click, once a point is correctly selected. This works, but there are still plenty clicks that do absolutely nothing.
Is there a more elegant way of doing this?
The code on the chart sheet:
The code in a module:
The code in a class module:
I have a path with xy coordinates that is expressed on an Excel chart. I want the user to be able to edit the path by repositioning points directly on the chart. The chart is on a chart sheet. The required methodology is as follows:
1) The user selects a point on the chart to be moved. This point is highlighted (made bigger in this case).
2) Any subsequesnt click in the chart area gets the coordiates of the click and changes the underlying data source.
3) As soon as the user clicks on a new point, the old point must be deselected, the new point becomes active and is now editable.
(Later on, the user must be able to insert or delete points, but first I must get the basics mastered.)
I've got it programmed and in a way it works, but:
• even if the user clicks on a new point to be selected, the old point is still moved. Somehow there are events firing when the new point is selected that I'm not manage to bypass.
• When a new point is selected, the user has to click on it twice. Not double click, but click for a second time. Again, the first click seems to be ineffectual, - because, I don't know, the chart area is selected with the fist click? - then the point is selected only on the second click.
I bypassed the problem by allowing point edits only with shift+click, once a point is correctly selected. This works, but there are still plenty clicks that do absolutely nothing.
Is there a more elegant way of doing this?
The code on the chart sheet:
VBA Code:
Public ThisPoint As Integer
Private Sub Chart_Activate()
Call RefreshChart
End Sub
Private Sub Chart_MouseDown(ByVal Button As Long, ByVal Shift As Long, ByVal x As Long, ByVal y As Long)
Dim p As Point
Dim i As Long
Dim intSeriesCount As Integer
Dim oAxis As Excel.Axis
Dim dzoom As Double
Dim dxval As Double
Dim dyval As Double
Dim dpixelsize As Double
Set wsFP = Worksheets("FlightPaths")
Set Chart = Charts("Map")
If TypeOf Selection Is Point Then
Set p = Selection
i = CLng(Split(p.Name, "P")(1))
Debug.Print i
Chart.SeriesCollection(1).MarkerSize = 5
Chart.SeriesCollection(1).Points(i).MarkerSize = 10
ThisPoint = i
Else
If Shift = 1 Then
dzoom = ActiveWindow.Zoom / 100
dpixelsize = PointsPerPixel()
Set oAxis = ActiveChart.Axes(xlCategory)
dxval = oAxis.MinimumScale + (oAxis.MaximumScale - oAxis.MinimumScale) * _
(x * dpixelsize / dzoom - _
(ActiveChart.PlotArea.InsideLeft + ActiveChart.ChartArea.Left)) _
/ ActiveChart.PlotArea.InsideWidth
Set oAxis = ActiveChart.Axes(xlValue)
dyval = oAxis.MinimumScale + (oAxis.MaximumScale - oAxis.MinimumScale) * _
(1 - (y * dpixelsize / dzoom - _
(ActiveChart.PlotArea.InsideTop + ActiveChart.ChartArea.Top)) _
/ ActiveChart.PlotArea.InsideHeight)
wsFP.Cells(1 + ThisPoint, 1) = dxval
wsFP.Cells(1 + ThisPoint, 2) = dyval
End IfThe code in a module:
VBA Code:
Option Explicit
Public Chart As Object
Public wsFP As Worksheet
Private Const LOGPIXELSX = 88 'Pixels/inch in X
'A point is defined as 1/72 inches
Private Const POINTS_PER_INCH As Long = 72
Public Chart1 As EventClass
#If VBA7 Then
Declare PtrSafe Function GetSystemMetrics Lib "user32" (ByVal Index As Long) As Long
Declare PtrSafe Function GetDC Lib "user32" (ByVal hWnd As Long) As Long
Declare PtrSafe Function ReleaseDC Lib "user32" (ByVal hWnd As Long, ByVal hDC As Long) As Long
Declare PtrSafe Function GetDeviceCaps Lib "gdi32" (ByVal hDC As Long, ByVal Index As Long) As Long
Declare PtrSafe Function GetWindowRect Lib "user32" (ByVal hWnd As Long, ByRef lpRect As udtRECT) As Long
#Else
Declare Function GetSystemMetrics Lib "user32" (ByVal Index As Long) As Long
Declare Function GetDC Lib "user32" (ByVal hWnd As Long) As Long
Declare Function ReleaseDC Lib "user32" (ByVal hWnd As Long, ByVal hDC As Long) As Long
Declare Function GetDeviceCaps Lib "gdi32" (ByVal hDC As Long, ByVal Index As Long) As Long
Declare Function GetWindowRect Lib "user32" (ByVal hWnd As Long, ByRef lpRect As udtRECT) As Long
#End If
Type udtRECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
Sub RefreshChart()
'Crazy code to refresh chart
Chart.Activate
DoEvents
Chart.Refresh
DoEvents
Chart.Activate
Chart.Refresh
End Sub
'The size of a pixel, in points
Public Function PointsPerPixel() As Double
Dim hDC As Long
Dim lDotsPerInch As Long
hDC = GetDC(0)
lDotsPerInch = GetDeviceCaps(hDC, LOGPIXELSX)
PointsPerPixel = POINTS_PER_INCH / lDotsPerInch
ReleaseDC 0, hDC
End Function
Public Sub ChartCoordinates()
Dim ochart1 As EventClass
Set ochart1 = New EventClass
Set ochart1.ExcelChartEvents = ActiveChart
End Sub
Public Function ConvertPixelsToPoints(ByVal sngPixels As Single, ByVal sXorY As String) As Single
Dim hDC As Long
hDC = GetDC(0)
If sXorY = "X" Then
ConvertPixelsToPoints = sngPixels * (72 / GetDeviceCaps(hDC, 88))
End If
If sXorY = "Y" Then
ConvertPixelsToPoints = sngPixels * (72 / GetDeviceCaps(hDC, 90))
End If
Call ReleaseDC(0, hDC)
End Function
End If
End SubThe code in a class module:
VBA Code:
Public WithEvents ExcelChartEvents As Excel.Chart
