Chart Zooming

[UKSteveM]

I have been working through Rob Boveys book on excel development and modified the examples of dynamic charting to attempt to allow the user to zoom into a chart with a rectangular shape defining the area.

I have a mouse down action capturing the x and y co-ordinates and use the mousemove to show the expanding rectangular area, I then have a mouse up action to capture the last x and y coordinates and change the x-axis limits, imitating a zoom feature.

The problem is using mousemove i cannot then use the mouseup to capture the last position and reassign the axis. Has anyone else experienced something similar?

I have pasted rough code and currently have the 'mousemove' commented out.

If anyone has any clues as to why the interaction will not work i would appreciate the feedback.

Cheers,

Steve

-----------------------------------Start Code

Option Explicit

Public WithEvents mchtChart As Chart

Public homeX As Double
Public homeY As Double
Public boxLeft As Double
Public boxTop As Double

Private Sub mchtChart_MouseMove(ByVal Button As Long, 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
Dim zoomPixel As Double

On Error Resume Next

'The active window zoom factor
dZoom = ActiveWindow.Zoom / 100

'The pixel size, in points
dPixelSize = PointsPerPixel

zoomPixel = PointsPerPixel / dZoom

'Mouse coordinates to Data coordinates
With mchtChart

Cells(16, 15) = X
Cells(17, 15) = Y

Cells(22, 15) = PointsPerPixel
Cells(23, 15) = ActiveWindow.Zoom

Cells(24, 15) = .Axes(xlCategory).MaximumScale
Cells(25, 15) = .Axes(xlCategory).MinimumScale
Cells(26, 15) = .Axes(xlValue).MaximumScale
Cells(27, 15) = .Axes(xlValue).MinimumScale


End With

Application.StatusBar = "(" & Application.Round(dXVal, 2) & ", " & Application.Round(dYVal, 2) & ")"


' Including this mousemove section for when the mouse is pressed, stops the action of the mouseup.


' Mouse coordinates to Drawing Object Points.
' Move the drawing object if the shift key is held down
' If Button = 1 Then
' With mchtChart
' If X * zoomPixel - 5 < homeX / dZoom Then boxLeft = X * zoomPixel - 5 Else boxLeft = homeX
' If Y * zoomPixel - 4 < homeY / dZoom Then boxTop = Y * zoomPixel - 5 Else boxTop = homeY
' .Shapes("Rectangle 126").Left = boxLeft
' .Shapes("Rectangle 126").Top = boxTop
' .Shapes("Rectangle 126").Visible = msoCTrue
' .Shapes("Rectangle 126").Width = Abs(X * zoomPixel - 5 - homeX)
' .Shapes("Rectangle 126").Height = Abs(Y * zoomPixel - 4 - homeY)
' DoEvents
' End With
' End If

End Sub


Private Sub mchtChart_MouseDown(ByVal Button As Long, ByVal Shift As Long, ByVal X As Long, ByVal Y As Long)

Dim dZoom As Double
Dim zoomPixel As Double
dZoom = ActiveWindow.Zoom / 100
zoomPixel = PointsPerPixel / dZoom
With mchtChart
.Shapes("Rectangle 126").Left = X
.Shapes("Rectangle 126").Top = Y
.Shapes("Rectangle 126").Width = 1
.Shapes("Rectangle 126").Height = 1
homeX = X * zoomPixel - 5
homeY = Y * zoomPixel - 4
DoEvents
End With
End Sub


Private Sub mchtChart_MouseUp(ByVal Button As Long, ByVal Shift As Long, ByVal X As Long, ByVal Y As Long)
With mchtChart
.Shapes("Rectangle 126").Visible = msoFalse
.Axes(xlCategory).MaximumScale = (boxLeft - homeX) * 0.096
.Axes(xlCategory).MinimumScale = homeX * 0.096
DoEvents
End With
End Sub

-----------------------------------End Code

 

[Oeloe]

If you just want to have result, search for "dynamic zooming", Richard01's post helped me out.