tool for dynamic zooming in XYcharts

R

Richard01

New Member
Joined
Jan 13, 2009
Messages
5
hi,

i would like to share with you a tool for dynamic zooming in XY-charts using the mouse to set up a zoom area. The axes scalings are changed to zoom in/out, the link to the original data is left untouched.
The zoom history is stored to conveniently scroll through the chart data.

(Currently, the number of charts for my application is limited to 30 with max. 10 levels of zoom each. Quite enough.)


Suggestions to further improve the code are welcome!

Unfortunately, I was unable to include a sample file.

Enjoy,
Richard.
(using Excel 2002)


This code goes into the Chart sheet (each Chart separately)
Code: 
Option Explicit
Private Sub Chart_Activate()
    On Error Resume Next
    Application.CommandBars("Zoom Tools").Visible = True
End Sub
Private Sub Chart_Deactivate()
    On Error Resume Next
    Application.CommandBars("Zoom Tools").Visible = False
    ZoomDisable
End Sub
Private Sub Chart_MouseDown(ByVal Button As Long, ByVal Shift As Long, ByVal x As Long, ByVal y As Long)
 
    If Not ZoomEnabled Then
        Exit Sub
    End If
 
    'start drawing the rectangle to zoom
    Application.CommandBars("Drawing").Controls("Rectangle").Execute
End Sub
Private Sub Chart_Select(ByVal ElementID As Long, ByVal Arg1 As Long, ByVal Arg2 As Long)
    If ZoomEnabled Then
        Select Case TypeName(Selection)
            Case "Rectangle"
                'copy newly created rectangle into ZoomBox object
                Set shpTemp = Selection
                shpTemp.Name = "ZoomBox"
                shpTemp.Visible = False
 
                'change zoom on chart
                ZoomInOnChart
 
                'remove ZoomBox object and clear ZoomEnabled-flag
                shpTemp.Delete
                ZoomEnabled = False
 
            Case Else
                ZoomEnabled = False
        End Select
    End If
 
    ActiveChart.Refresh
End Sub
This code goes into a std. Module (Here's where the actual zooming takes place; most of the code is for logging the zoom history. Curious? Jump to "ZoomInOnChart()")
Code: 
Public ZoomEnabled As Boolean
Public ZoomPrev As Boolean
Public ZoomNxt As Boolean
Private Type AxisXYMinMax
    minX1 As Single
    minX2 As Single
    minY1 As Single
    minY2 As Single
    maxX1 As Single
    maxX2 As Single
    maxY1 As Single
    maxY2 As Single
End Type
Private Type ZmHis
    chrtname(30) As String
    current(30) As Long
    last(30) As Long
    axs(30, 10) As AxisXYMinMax
End Type
Public ZoomHistory As ZmHis
Public shpTemp As Object
 
Sub ZoomDisable()
    ZoomEnabled = False
End Sub
 
Sub ZoomIn()
    ZoomEnabled = True
End Sub
 
Sub ZoomAll()
    Dim i As Single, j As Single
    Application.ScreenUpdating = False
    ' find current chart name or introduce new chart name to array to store zoom history
    For i = 1 To 30
        If ZoomHistory.chrtname(i) = ActiveChart.Name Then
            Exit For
        ElseIf ZoomHistory.chrtname(i) = "" Then
            ZoomHistory.chrtname(i) = ActiveChart.Name
            Exit For
        End If
    Next i
'set axes to max. scales
    With ActiveChart.Axes(xlValue)
        .MinimumScaleIsAuto = True
        .MaximumScaleIsAuto = True
    End With
    With ActiveChart.Axes(xlCategory)
        .MinimumScaleIsAuto = True
        .MaximumScaleIsAuto = True
    End With
    'check for secondary axes
    If ActiveChart.HasAxis(xlCategory, xlSecondary) Then
        With ActiveChart.Axes(xlCategory, xlSecondary)
            .MinimumScaleIsAuto = True
            .MaximumScaleIsAuto = True
        End With
    End If
    If ActiveChart.HasAxis(xlValue, xlSecondary) Then
        With ActiveChart.Axes(xlValue, xlSecondary)
            .MinimumScaleIsAuto = True
            .MaximumScaleIsAuto = True
        End With
    End If
'reset ZoomHistory after <ZOOMALL>
    ZoomHistory.current(i) = 0
    ZoomHistory.last(i) = 0
 
    Application.ScreenUpdating = True
End Sub
 
Sub ZoomPrevious()
    Dim i As Long
 
    ' find current chart name in zoom history
    For i = 1 To 30
        If ZoomHistory.chrtname(i) = ActiveChart.Name Then
            Exit For
        ElseIf ZoomHistory.chrtname(i) = "" Then    'no zoom history for this chart
            Exit Sub
        End If
    Next i
 
    Application.ScreenUpdating = False
 
 
    With ZoomHistory
        If .current(i) = 0 Then Exit Sub   'status after ZoomAll
 
        .current(i) = WorksheetFunction.Max(.current(i) - 1, 1)  'using "Max" iso. If-Then loop
        ' ".last" is unchanged
        ActiveChart.Axes(xlCategory, xlPrimary).MinimumScale = .axs(i, .current(i)).minX1
        ActiveChart.Axes(xlValue, xlPrimary).MinimumScale = .axs(i, .current(i)).minY1
        ActiveChart.Axes(xlCategory, xlPrimary).MaximumScale = .axs(i, .current(i)).maxX1
        ActiveChart.Axes(xlValue, xlPrimary).MaximumScale = .axs(i, .current(i)).maxY1
 
        If ActiveChart.HasAxis(xlCategory, xlSecondary) Then
          ActiveChart.Axes(xlCategory, xlSecondary).MinimumScale = .axs(i, .current(i)).minX2
          ActiveChart.Axes(xlCategory, xlSecondary).MaximumScale = .axs(i, .current(i)).maxX2
        End If
 
        If ActiveChart.HasAxis(xlValue, xlSecondary) Then
         ActiveChart.Axes(xlValue, xlSecondary).MinimumScale = .axs(i, .current(i)).minY2
         ActiveChart.Axes(xlValue, xlSecondary).MaximumScale = .axs(i, .current(i)).maxY2
        End If
    End With
 
    Application.ScreenUpdating = True
End Sub
 
Sub ZoomNext()
    Dim i As Long
 
    ' find current chart name in zoom history
    For i = 1 To 30
        If ZoomHistory.chrtname(i) = ActiveChart.Name Then
            Exit For
        ElseIf ZoomHistory.chrtname(i) = "" Then    'no zoom history for this chart
            Exit Sub
        End If
    Next i
 
    Application.ScreenUpdating = False
 
 
    With ZoomHistory
        If .current(i) = 0 Then Exit Sub   'status after ZoomAll
 
        .current(i) = WorksheetFunction.Min(.current(i) + 1, .last(i)) 'using "Min" iso. If-Then loop
        ' .last is unchanged
        ActiveChart.Axes(xlCategory, xlPrimary).MinimumScale = .axs(i, .current(i)).minX1
        ActiveChart.Axes(xlValue, xlPrimary).MinimumScale = .axs(i, .current(i)).minY1
        ActiveChart.Axes(xlCategory, xlPrimary).MaximumScale = .axs(i, .current(i)).maxX1
        ActiveChart.Axes(xlValue, xlPrimary).MaximumScale = .axs(i, .current(i)).maxY1
 
        If ActiveChart.HasAxis(xlCategory, xlSecondary) Then
          ActiveChart.Axes(xlCategory, xlSecondary).MinimumScale = .axs(i, .current(i)).minX2
          ActiveChart.Axes(xlCategory, xlSecondary).MaximumScale = .axs(i, .current(i)).maxX2
        End If
 
        If ActiveChart.HasAxis(xlValue, xlSecondary) Then
         ActiveChart.Axes(xlValue, xlSecondary).MinimumScale = .axs(i, .current(i)).minY2
         ActiveChart.Axes(xlValue, xlSecondary).MaximumScale = .axs(i, .current(i)).maxY2
        End If
    End With
 
    Application.ScreenUpdating = True
End Sub
 
Sub ShowDataSeries()
    'TBW
    MsgBox "Sorry, not implemented yet :-("
End Sub
 
Sub ZoomHelp()
    'TBW
    MsgBox "Sorry, not implemented yet :-("
End Sub
 
Sub ZoomInOnChart()
    'overlapping rectangle parameters
    Dim x_min_pnts As Single, y_min_pnts As Single
    Dim x_max_pnts As Single, y_max_pnts As Single
 
    'axis length for scaling
    Dim XAxesLength As Single, YAxesLength As Single
 
    'new min/max values for X/Y axis
    Dim xax_min(2) As Single, xax_max(2) As Single
    Dim yax_min(2) As Single, yax_max(2) As Single
 
    'plotarea params
    Dim plInsW As Single, plInsH As Single
 
    Dim i As Long
 
    ' find current chart name or introduce new chart name to array to store zoom history
    For i = 1 To 30
        If ZoomHistory.chrtname(i) = ActiveChart.Name Then
            Exit For
        ElseIf ZoomHistory.chrtname(i) = "" Then
            ZoomHistory.chrtname(i) = ActiveChart.Name
            Exit For
        End If
    Next i
'store current axes settings in ZoomHistory table
    If ZoomHistory.current(i) = 0 Then ExpandZoomHistory   'store initial view
 

'define overlap of rectangles <ZOOMBOX>and 
 |  units: points</P>    With ActiveChart
        x_min_pnts = shpTemp.Left - .PlotArea.InsideLeft
        y_min_pnts = (.PlotArea.InsideTop + .PlotArea.InsideHeight) - (shpTemp.Top + shpTemp.Height)
        x_max_pnts = x_min_pnts + shpTemp.Width
        y_max_pnts = y_min_pnts + shpTemp.Height
    End With
'define new scaling parameters
    With ActiveChart
        plInsW = .PlotArea.InsideWidth
        With .Axes(xlCategory)    'prim. x-axis (always present)
            XAxesLength = (.MaximumScale - .MinimumScale)
            xax_min(xlPrimary) = .MinimumScale + (x_min_pnts / plInsW) * XAxesLength
            xax_max(xlPrimary) = .MinimumScale + (x_max_pnts / plInsW) * XAxesLength
        End With
        plInsH = .PlotArea.InsideHeight
        With .Axes(xlValue)       'prim. y-axis (always present)
            YAxesLength = (.MaximumScale - .MinimumScale)
            yax_min(xlPrimary) = .MinimumScale + (y_min_pnts / plInsH) * YAxesLength
            yax_max(xlPrimary) = .MinimumScale + (y_max_pnts / plInsH) * YAxesLength
        End With
 
        'check for secondary axis X or Y
        If ActiveChart.HasAxis(xlCategory, xlSecondary) Then
            With .Axes(xlCategory, xlSecondary)
                XAxesLength = (.MaximumScale - .MinimumScale)
                xax_min(xlSecondary) = .MinimumScale + (x_min_pnts / plInsW) * XAxesLength
                xax_max(xlSecondary) = .MinimumScale + (x_max_pnts / plInsW) * XAxesLength
            End With
        End If
        If ActiveChart.HasAxis(xlValue, xlSecondary) Then
            With .Axes(xlValue, xlSecondary)
                YAxesLength = (.MaximumScale - .MinimumScale)
                yax_min(xlSecondary) = .MinimumScale + (y_min_pnts / plInsH) * YAxesLength
                yax_max(xlSecondary) = .MinimumScale + (y_max_pnts / plInsH) * YAxesLength
            End With
        End If
    End With
 
'adjust chart scaling
    Application.ScreenUpdating = False
    With ActiveChart
        With .Axes(xlCategory, xlPrimary)      'prim. x-axis
            .MinimumScale = xax_min(xlPrimary)
            .MaximumScale = xax_max(xlPrimary)
        End With
        With .Axes(xlValue, xlPrimary)         'prim. y-axis
            .MinimumScale = yax_min(xlPrimary)
            .MaximumScale = yax_max(xlPrimary)
        End With
        If ActiveChart.HasAxis(xlCategory, xlSecondary) Then
            With .Axes(xlCategory, xlSecondary)     'sec. x-axis
                .MinimumScale = xax_min(xlSecondary)
                .MaximumScale = xax_max(xlSecondary)
            End With
        End If
        If ActiveChart.HasAxis(xlValue, xlSecondary) Then
            With .Axes(xlValue, xlSecondary)        'sec. y-axis
                .MinimumScale = yax_min(xlSecondary)
                .MaximumScale = yax_max(xlSecondary)
            End With
        End If
    End With
 
    Application.ScreenUpdating = True
 
'store current axis settings in ZoomHistory table
    ExpandZoomHistory   'store actual view
 
End Sub
 
Sub ExpandZoomHistory()
    ' store zoom history
    ' <.current(i)> points to the latest view
    Dim i As Long
 
    ' find current chart name or introduce new chart name to array to store zoom history
    For i = 1 To 30
        If ZoomHistory.chrtname(i) = ActiveChart.Name Then
            Exit For
        ElseIf ZoomHistory.chrtname(i) = "" Then
            ZoomHistory.chrtname(i) = ActiveChart.Name
            Exit For
        End If
    Next i
 
 
    With ZoomHistory
        .current(i) = WorksheetFunction.Min(.current(i) + 1, 10)  'max. 10 history levels
        .last(i) = .current(i) ' if some ZoomPrevious took place in between Zooms, Last will be reset to Current
        .axs(i, .current(i)).minX1 = ActiveChart.Axes(xlCategory, xlPrimary).MinimumScale
        .axs(i, .current(i)).minY1 = ActiveChart.Axes(xlValue, xlPrimary).MinimumScale
        .axs(i, .current(i)).maxX1 = ActiveChart.Axes(xlCategory, xlPrimary).MaximumScale
        .axs(i, .current(i)).maxY1 = ActiveChart.Axes(xlValue, xlPrimary).MaximumScale
 
        If ActiveChart.HasAxis(xlCategory, xlSecondary) Then
          .axs(i, .current(i)).minX2 = ActiveChart.Axes(xlCategory, xlSecondary).MinimumScale
          .axs(i, .current(i)).maxX2 = ActiveChart.Axes(xlCategory, xlSecondary).MaximumScale
        End If
        If ActiveChart.HasAxis(xlValue, xlSecondary) Then
         .axs(i, .current(i)).minY2 = ActiveChart.Axes(xlValue, xlSecondary).MinimumScale
         .axs(i, .current(i)).maxY2 = ActiveChart.Axes(xlValue, xlSecondary).MaximumScale
        End If
    End With
End Sub
This goes into the ThisWorkbook module (create zoom toolbar at FileOpen)
Code: 
[INDENT]Option Explicit
Private Sub Workbook_Open()
    ' actions at file open:
    ' toolbar(s) creation
 
    CreateZoomToolbar    'zoom toolbar for charts
    'activate Zoom Toolbar if active sheet is chart object
    On Error Resume Next
    If ActiveChart.Name <> "" Then
        'check if active sheet is chart object
    End If
    If Err.Number = 0 Then  'active sheet is chart object
        Application.CommandBars("Zoom Tools").Visible = True
    End If
End Sub
Private Sub Workbook_BeforeClose(Cancel As Boolean)
    ' actions at file close:
    ' toolbar(s) delete
    On Error Resume Next
 
    DeleteZoomToolbar  'Zoom Toolbar delete
 
End Sub
Sub DeleteZoomToolbar()
    On Error Resume Next
    Application.CommandBars("Zoom Tools").Delete
End Sub
Sub CreateZoomToolbar()
    Dim cbWSMenuBar As CommandBar
 
    DeleteZoomToolbar
 
    On Error Resume Next
    Set cbWSMenuBar = Application.CommandBars.Add("Zoom Tools")
    With cbWSMenuBar
        With .Controls.Add(Type:=msoControlButton)
            .Caption = "Zoom Disable"
            .Style = msoButtonCaption
            .OnAction = "ZoomDisable"
        End With
        With .Controls.Add(Type:=msoControlButton)
            .Caption = "Zoom        "
            .Style = msoButtonCaption
            .OnAction = "ZoomIn"
        End With
        With .Controls.Add(Type:=msoControlButton)
            .Caption = "Zoom All    "
            .Style = msoButtonCaption
            .OnAction = "ZoomAll"
        End With
        With .Controls.Add(Type:=msoControlButton)
            .Caption = "Zoom Previous"
            .Style = msoButtonCaption
            .OnAction = "ZoomPrevious"
        End With
        With .Controls.Add(Type:=msoControlButton)
            .Caption = "Zoom Next   "
            .Style = msoButtonCaption
            .OnAction = "ZoomNext"
        End With
        With .Controls.Add(Type:=msoControlButton)
            .Caption = "Show Data Series"
            .Style = msoButtonCaption
            .OnAction = "ShowDataSeries"
        End With
        With .Controls.Add(Type:=msoControlButton)
            .Caption = "Help        "
            .Style = msoButtonCaption
            .OnAction = "ZoomHelp"
        End With
    End With
End Sub
[/INDENT]
 

Excel Facts

Can you sort left to right?
To sort left-to-right, use the Sort dialog box. Click Options. Choose "Sort left to right"
Sort by date Sort by votes
Hi richard01,

i just want to thank you for publishing your code, it works perfectly and saved me a lot of time trying to code something similar by myself.

Two notes:
1. in the code for the std.module, the code sequence "With ActiveChart" is marked as comment in your code listing, however it should look like this:

'define overlap of rectangles and
' units: points
With ActiveChart


2. I use the german version of excel2002. In this version, in the code line...

Application.CommandBars("Drawing").Controls("Rectangle").Execute

..."Drawing" can stay in its original english language, but "Rectangle" has to be replaced with the country-specific tranlated word (for the german version, I had to replace it with "Rechteck").
No idea if this is known to you, for me it was not.

Thanks again for your posting!

christian
 
Upvote 0
Amazing!

Exactly what i needed!
Thank you so much!

chrbr's remarks were very usefull as well
 
Upvote 0
This code works really well except for one problem. I can't seem to start a selection on the plot area. It only works for me if I start the selection on the chart area. Am I just being a newb here?
 
Upvote 0
Richard,

I am to some degree a newb to vba and have tried to implement your code. It seems to be a very nice feature. However I do not use separate chart sheets but various charts on a sheet. I have copied the code in a std module and and thisworkbook as indicated and copied the chart code into the sheet on which the graphs are. I have saved and reopened the workbook but nothing happens when I click on the chart. No zoombar nothing. I am sure it must be me. Any ideas ?

Paul

PS: I am using excel 2007


Richard01 said:
hi,

i would like to share with you a tool for dynamic zooming in XY-charts using the mouse to set up a zoom area. The axes scalings are changed to zoom in/out, the link to the original data is left untouched.
The zoom history is stored to conveniently scroll through the chart data.

(Currently, the number of charts for my application is limited to 30 with max. 10 levels of zoom each. Quite enough.)


Suggestions to further improve the code are welcome!

Unfortunately, I was unable to include a sample file.

Enjoy,
Richard.
(using Excel 2002)


This code goes into the Chart sheet (each Chart separately)
Code: 
Option Explicit
Private Sub Chart_Activate()
    On Error Resume Next
    Application.CommandBars("Zoom Tools").Visible = True
End Sub
Private Sub Chart_Deactivate()
    On Error Resume Next
    Application.CommandBars("Zoom Tools").Visible = False
    ZoomDisable
End Sub
Private Sub Chart_MouseDown(ByVal Button As Long, ByVal Shift As Long, ByVal x As Long, ByVal y As Long)
 
    If Not ZoomEnabled Then
        Exit Sub
    End If
 
    'start drawing the rectangle to zoom
    Application.CommandBars("Drawing").Controls("Rectangle").Execute
End Sub
Private Sub Chart_Select(ByVal ElementID As Long, ByVal Arg1 As Long, ByVal Arg2 As Long)
    If ZoomEnabled Then
        Select Case TypeName(Selection)
            Case "Rectangle"
                'copy newly created rectangle into ZoomBox object
                Set shpTemp = Selection
                shpTemp.Name = "ZoomBox"
                shpTemp.Visible = False
 
                'change zoom on chart
                ZoomInOnChart
 
                'remove ZoomBox object and clear ZoomEnabled-flag
                shpTemp.Delete
                ZoomEnabled = False
 
            Case Else
                ZoomEnabled = False
        End Select
    End If
 
    ActiveChart.Refresh
End Sub
This code goes into a std. Module (Here's where the actual zooming takes place; most of the code is for logging the zoom history. Curious? Jump to "ZoomInOnChart()")
Code: 
Public ZoomEnabled As Boolean
Public ZoomPrev As Boolean
Public ZoomNxt As Boolean
Private Type AxisXYMinMax
    minX1 As Single
    minX2 As Single
    minY1 As Single
    minY2 As Single
    maxX1 As Single
    maxX2 As Single
    maxY1 As Single
    maxY2 As Single
End Type
Private Type ZmHis
    chrtname(30) As String
    current(30) As Long
    last(30) As Long
    axs(30, 10) As AxisXYMinMax
End Type
Public ZoomHistory As ZmHis
Public shpTemp As Object
 
Sub ZoomDisable()
    ZoomEnabled = False
End Sub
 
Sub ZoomIn()
    ZoomEnabled = True
End Sub
 
Sub ZoomAll()
    Dim i As Single, j As Single
    Application.ScreenUpdating = False
    ' find current chart name or introduce new chart name to array to store zoom history
    For i = 1 To 30
        If ZoomHistory.chrtname(i) = ActiveChart.Name Then
            Exit For
        ElseIf ZoomHistory.chrtname(i) = "" Then
            ZoomHistory.chrtname(i) = ActiveChart.Name
            Exit For
        End If
    Next i
'set axes to max. scales
    With ActiveChart.Axes(xlValue)
        .MinimumScaleIsAuto = True
        .MaximumScaleIsAuto = True
    End With
    With ActiveChart.Axes(xlCategory)
        .MinimumScaleIsAuto = True
        .MaximumScaleIsAuto = True
    End With
    'check for secondary axes
    If ActiveChart.HasAxis(xlCategory, xlSecondary) Then
        With ActiveChart.Axes(xlCategory, xlSecondary)
            .MinimumScaleIsAuto = True
            .MaximumScaleIsAuto = True
        End With
    End If
    If ActiveChart.HasAxis(xlValue, xlSecondary) Then
        With ActiveChart.Axes(xlValue, xlSecondary)
            .MinimumScaleIsAuto = True
            .MaximumScaleIsAuto = True
        End With
    End If
'reset ZoomHistory after <zoomall>
    ZoomHistory.current(i) = 0
    ZoomHistory.last(i) = 0
 
    Application.ScreenUpdating = True
End Sub
 
Sub ZoomPrevious()
    Dim i As Long
 
    ' find current chart name in zoom history
    For i = 1 To 30
        If ZoomHistory.chrtname(i) = ActiveChart.Name Then
            Exit For
        ElseIf ZoomHistory.chrtname(i) = "" Then    'no zoom history for this chart
            Exit Sub
        End If
    Next i
 
    Application.ScreenUpdating = False
 
 
    With ZoomHistory
        If .current(i) = 0 Then Exit Sub   'status after ZoomAll
 
        .current(i) = WorksheetFunction.Max(.current(i) - 1, 1)  'using "Max" iso. If-Then loop
        ' ".last" is unchanged
        ActiveChart.Axes(xlCategory, xlPrimary).MinimumScale = .axs(i, .current(i)).minX1
        ActiveChart.Axes(xlValue, xlPrimary).MinimumScale = .axs(i, .current(i)).minY1
        ActiveChart.Axes(xlCategory, xlPrimary).MaximumScale = .axs(i, .current(i)).maxX1
        ActiveChart.Axes(xlValue, xlPrimary).MaximumScale = .axs(i, .current(i)).maxY1
 
        If ActiveChart.HasAxis(xlCategory, xlSecondary) Then
          ActiveChart.Axes(xlCategory, xlSecondary).MinimumScale = .axs(i, .current(i)).minX2
          ActiveChart.Axes(xlCategory, xlSecondary).MaximumScale = .axs(i, .current(i)).maxX2
        End If
 
        If ActiveChart.HasAxis(xlValue, xlSecondary) Then
         ActiveChart.Axes(xlValue, xlSecondary).MinimumScale = .axs(i, .current(i)).minY2
         ActiveChart.Axes(xlValue, xlSecondary).MaximumScale = .axs(i, .current(i)).maxY2
        End If
    End With
 
    Application.ScreenUpdating = True
End Sub
 
Sub ZoomNext()
    Dim i As Long
 
    ' find current chart name in zoom history
    For i = 1 To 30
        If ZoomHistory.chrtname(i) = ActiveChart.Name Then
            Exit For
        ElseIf ZoomHistory.chrtname(i) = "" Then    'no zoom history for this chart
            Exit Sub
        End If
    Next i
 
    Application.ScreenUpdating = False
 
 
    With ZoomHistory
        If .current(i) = 0 Then Exit Sub   'status after ZoomAll
 
        .current(i) = WorksheetFunction.Min(.current(i) + 1, .last(i)) 'using "Min" iso. If-Then loop
        ' .last is unchanged
        ActiveChart.Axes(xlCategory, xlPrimary).MinimumScale = .axs(i, .current(i)).minX1
        ActiveChart.Axes(xlValue, xlPrimary).MinimumScale = .axs(i, .current(i)).minY1
        ActiveChart.Axes(xlCategory, xlPrimary).MaximumScale = .axs(i, .current(i)).maxX1
        ActiveChart.Axes(xlValue, xlPrimary).MaximumScale = .axs(i, .current(i)).maxY1
 
        If ActiveChart.HasAxis(xlCategory, xlSecondary) Then
          ActiveChart.Axes(xlCategory, xlSecondary).MinimumScale = .axs(i, .current(i)).minX2
          ActiveChart.Axes(xlCategory, xlSecondary).MaximumScale = .axs(i, .current(i)).maxX2
        End If
 
        If ActiveChart.HasAxis(xlValue, xlSecondary) Then
         ActiveChart.Axes(xlValue, xlSecondary).MinimumScale = .axs(i, .current(i)).minY2
         ActiveChart.Axes(xlValue, xlSecondary).MaximumScale = .axs(i, .current(i)).maxY2
        End If
    End With
 
    Application.ScreenUpdating = True
End Sub
 
Sub ShowDataSeries()
    'TBW
    MsgBox "Sorry, not implemented yet :-("
End Sub
 
Sub ZoomHelp()
    'TBW
    MsgBox "Sorry, not implemented yet :-("
End Sub
 
Sub ZoomInOnChart()
    'overlapping rectangle parameters
    Dim x_min_pnts As Single, y_min_pnts As Single
    Dim x_max_pnts As Single, y_max_pnts As Single
 
    'axis length for scaling
    Dim XAxesLength As Single, YAxesLength As Single
 
    'new min/max values for X/Y axis
    Dim xax_min(2) As Single, xax_max(2) As Single
    Dim yax_min(2) As Single, yax_max(2) As Single
 
    'plotarea params
    Dim plInsW As Single, plInsH As Single
 
    Dim i As Long
 
    ' find current chart name or introduce new chart name to array to store zoom history
    For i = 1 To 30
        If ZoomHistory.chrtname(i) = ActiveChart.Name Then
            Exit For
        ElseIf ZoomHistory.chrtname(i) = "" Then
            ZoomHistory.chrtname(i) = ActiveChart.Name
            Exit For
        End If
    Next i
'store current axes settings in ZoomHistory table
    If ZoomHistory.current(i) = 0 Then ExpandZoomHistory   'store initial view
 

'define overlap of rectangles <zoombox>and 
 |  units: points    With ActiveChart
        x_min_pnts = shpTemp.Left - .PlotArea.InsideLeft
        y_min_pnts = (.PlotArea.InsideTop + .PlotArea.InsideHeight) - (shpTemp.Top + shpTemp.Height)
        x_max_pnts = x_min_pnts + shpTemp.Width
        y_max_pnts = y_min_pnts + shpTemp.Height
    End With
'define new scaling parameters
    With ActiveChart
        plInsW = .PlotArea.InsideWidth
        With .Axes(xlCategory)    'prim. x-axis (always present)
            XAxesLength = (.MaximumScale - .MinimumScale)
            xax_min(xlPrimary) = .MinimumScale + (x_min_pnts / plInsW) * XAxesLength
            xax_max(xlPrimary) = .MinimumScale + (x_max_pnts / plInsW) * XAxesLength
        End With
        plInsH = .PlotArea.InsideHeight
        With .Axes(xlValue)       'prim. y-axis (always present)
            YAxesLength = (.MaximumScale - .MinimumScale)
            yax_min(xlPrimary) = .MinimumScale + (y_min_pnts / plInsH) * YAxesLength
            yax_max(xlPrimary) = .MinimumScale + (y_max_pnts / plInsH) * YAxesLength
        End With
 
        'check for secondary axis X or Y
        If ActiveChart.HasAxis(xlCategory, xlSecondary) Then
            With .Axes(xlCategory, xlSecondary)
                XAxesLength = (.MaximumScale - .MinimumScale)
                xax_min(xlSecondary) = .MinimumScale + (x_min_pnts / plInsW) * XAxesLength
                xax_max(xlSecondary) = .MinimumScale + (x_max_pnts / plInsW) * XAxesLength
            End With
        End If
        If ActiveChart.HasAxis(xlValue, xlSecondary) Then
            With .Axes(xlValue, xlSecondary)
                YAxesLength = (.MaximumScale - .MinimumScale)
                yax_min(xlSecondary) = .MinimumScale + (y_min_pnts / plInsH) * YAxesLength
                yax_max(xlSecondary) = .MinimumScale + (y_max_pnts / plInsH) * YAxesLength
            End With
        End If
    End With
 
'adjust chart scaling
    Application.ScreenUpdating = False
    With ActiveChart
        With .Axes(xlCategory, xlPrimary)      'prim. x-axis
            .MinimumScale = xax_min(xlPrimary)
            .MaximumScale = xax_max(xlPrimary)
        End With
        With .Axes(xlValue, xlPrimary)         'prim. y-axis
            .MinimumScale = yax_min(xlPrimary)
            .MaximumScale = yax_max(xlPrimary)
        End With
        If ActiveChart.HasAxis(xlCategory, xlSecondary) Then
            With .Axes(xlCategory, xlSecondary)     'sec. x-axis
                .MinimumScale = xax_min(xlSecondary)
                .MaximumScale = xax_max(xlSecondary)
            End With
        End If
        If ActiveChart.HasAxis(xlValue, xlSecondary) Then
            With .Axes(xlValue, xlSecondary)        'sec. y-axis
                .MinimumScale = yax_min(xlSecondary)
                .MaximumScale = yax_max(xlSecondary)
            End With
        End If
    End With
 
    Application.ScreenUpdating = True
 
'store current axis settings in ZoomHistory table
    ExpandZoomHistory   'store actual view
 
End Sub
 
Sub ExpandZoomHistory()
    ' store zoom history
    ' <.current(i)> points to the latest view
    Dim i As Long
 
    ' find current chart name or introduce new chart name to array to store zoom history
    For i = 1 To 30
        If ZoomHistory.chrtname(i) = ActiveChart.Name Then
            Exit For
        ElseIf ZoomHistory.chrtname(i) = "" Then
            ZoomHistory.chrtname(i) = ActiveChart.Name
            Exit For
        End If
    Next i
 
 
    With ZoomHistory
        .current(i) = WorksheetFunction.Min(.current(i) + 1, 10)  'max. 10 history levels
        .last(i) = .current(i) ' if some ZoomPrevious took place in between Zooms, Last will be reset to Current
        .axs(i, .current(i)).minX1 = ActiveChart.Axes(xlCategory, xlPrimary).MinimumScale
        .axs(i, .current(i)).minY1 = ActiveChart.Axes(xlValue, xlPrimary).MinimumScale
        .axs(i, .current(i)).maxX1 = ActiveChart.Axes(xlCategory, xlPrimary).MaximumScale
        .axs(i, .current(i)).maxY1 = ActiveChart.Axes(xlValue, xlPrimary).MaximumScale
 
        If ActiveChart.HasAxis(xlCategory, xlSecondary) Then
          .axs(i, .current(i)).minX2 = ActiveChart.Axes(xlCategory, xlSecondary).MinimumScale
          .axs(i, .current(i)).maxX2 = ActiveChart.Axes(xlCategory, xlSecondary).MaximumScale
        End If
        If ActiveChart.HasAxis(xlValue, xlSecondary) Then
         .axs(i, .current(i)).minY2 = ActiveChart.Axes(xlValue, xlSecondary).MinimumScale
         .axs(i, .current(i)).maxY2 = ActiveChart.Axes(xlValue, xlSecondary).MaximumScale
        End If
    End With
End Sub
</zoombox></zoomall>​
This goes into the ThisWorkbook module (create zoom toolbar at FileOpen)
Code: 
[INDENT]Option Explicit
Private Sub Workbook_Open()
    ' actions at file open:
    ' toolbar(s) creation
 
    CreateZoomToolbar    'zoom toolbar for charts
    'activate Zoom Toolbar if active sheet is chart object
    On Error Resume Next
    If ActiveChart.Name <> "" Then
        'check if active sheet is chart object
    End If
    If Err.Number = 0 Then  'active sheet is chart object
        Application.CommandBars("Zoom Tools").Visible = True
    End If
End Sub
Private Sub Workbook_BeforeClose(Cancel As Boolean)
    ' actions at file close:
    ' toolbar(s) delete
    On Error Resume Next
 
    DeleteZoomToolbar  'Zoom Toolbar delete
 
End Sub
Sub DeleteZoomToolbar()
    On Error Resume Next
    Application.CommandBars("Zoom Tools").Delete
End Sub
Sub CreateZoomToolbar()
    Dim cbWSMenuBar As CommandBar
 
    DeleteZoomToolbar
 
    On Error Resume Next
    Set cbWSMenuBar = Application.CommandBars.Add("Zoom Tools")
    With cbWSMenuBar
        With .Controls.Add(Type:=msoControlButton)
            .Caption = "Zoom Disable"
            .Style = msoButtonCaption
            .OnAction = "ZoomDisable"
        End With
        With .Controls.Add(Type:=msoControlButton)
            .Caption = "Zoom        "
            .Style = msoButtonCaption
            .OnAction = "ZoomIn"
        End With
        With .Controls.Add(Type:=msoControlButton)
            .Caption = "Zoom All    "
            .Style = msoButtonCaption
            .OnAction = "ZoomAll"
        End With
        With .Controls.Add(Type:=msoControlButton)
            .Caption = "Zoom Previous"
            .Style = msoButtonCaption
            .OnAction = "ZoomPrevious"
        End With
        With .Controls.Add(Type:=msoControlButton)
            .Caption = "Zoom Next   "
            .Style = msoButtonCaption
            .OnAction = "ZoomNext"
        End With
        With .Controls.Add(Type:=msoControlButton)
            .Caption = "Show Data Series"
            .Style = msoButtonCaption
            .OnAction = "ShowDataSeries"
        End With
        With .Controls.Add(Type:=msoControlButton)
            .Caption = "Help        "
            .Style = msoButtonCaption
            .OnAction = "ZoomHelp"
        End With
    End With
End Sub
[/INDENT]
Click to expand...
 
Upvote 0
Hi, I found this code very useful.
The code works very well but I would ask if it could work in a slightly different case: I have a file that can contains different chart objects (chart sheets), not possible to known in advance (because I create them working on the first sheet).
I think it can be done by moving the code from the Chart sheet to another separate module that works for every chart objects created but I have to add a reference from the active chart to that code and I don't know how.
Any idea on how to do this?
Thanks!
 
Upvote 0
I realize this is an old thread, but hoping somebody can help me adapt to implement in Excel 2007. VBA seems to be having trouble with this command:

Application.CommandBars("Drawing").Controls("Rectangle").Execute

Any help?

Thanks in advance!
 
Upvote 0
You must log in or register to reply here.

Similar threads

F
  • Solved
VBA to change Chart fonts on all charts in a sheet
Replies
3
Views
639
Domenic
D
P
  • Question
Turning OFF the visibility of a horizontal (category) axis labels if certain conditions apply
Replies
1
Views
411
NdNoviceHlp
NdNoviceHlp
D
  • Question
Set chart properties without selecting chart
Replies
4
Views
352
smozgur
smozgur
I
  • Question
Data formatting for Chart
Replies
3
Views
332
IREALLYambatman
I
T
  • Solved
Chart point must move to point of click in chart
Replies
2
Views
84
tigger_na
T

Forum statistics

Threads
1,215,161
Messages
6,123,377
Members
449,097
Latest member
Jabe

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top