zoom in to graph

iknowu99

iknowu99

Well-known Member
Joined
Dec 26, 2004
Messages
1,158
i have made miniature graphs in excel like a dashboard but i want to be able to hover over them or dbl click and have a zoomed in version....i know if i select data and press F11 it charts it for me but can the graph itself be the trigger point?
 

Excel Facts

What did Pito Salas invent?
Pito Salas, working for Lotus, popularized what would become to be pivot tables. It was released as Lotus Improv in 1989.
Sort by date Sort by votes
can't download it ....i even registered for your site...


1. Your user account may not have sufficient privileges to access this page. Are you trying to edit someone else's post, access administrative features or some other privileged system?
2. If you are trying to post, the administrator may have disabled your account, or it may be awaiting activation.
 
Upvote 0
got it...
nice job...i would show some certificates on that site ...wasn't sure if i was downloadin malicious macro there...thanks for this code:
Code: 
Sub Chart1_Click()
    ZoomChartInAndOut ActiveSheet.ChartObjects(Application.Caller)
End Sub
Sub Chart2_Click()
    ZoomChartInAndOut ActiveSheet.ChartObjects(Application.Caller)
End Sub
Sub Chart3_Click()
    ZoomChartInAndOut ActiveSheet.ChartObjects(Application.Caller)
End Sub

Public strObjNames As String
Sub ZoomChartInAndOut(ByRef ChartToZoomInAndOut As ChartObject, Optional ByVal blnShowShapes As Boolean = 0)
    '// Author      : Krishnakumar @ ExcelFox.com
    '// Created on  : 23-Mar-2011
    '// Purpose     : Resize Chart
    
    Dim blnZoomIn       As Boolean
    Dim lngBlnPos       As Long
    Dim lngLoop         As Long
    Dim rngVisible      As Range
    Dim objObject       As Object
    Dim shpChart        As Shape
    Dim strTemp         As String
    Dim strAltText      As String
    Dim strShp          As String
    Dim OldCSFS         As String
    Dim OldCAFS         As Single
    Dim NewCAFS         As Single
    Dim OldCTFS         As Single
    Dim NewCTFS         As Single
    Dim NewCSFS()       As Single
    Dim SplitText       As Variant
    Dim SplitAddr       As Variant
    Dim SplitCSFS       As Variant
    Dim strNewCSFS      As String
    Dim strSAold        As String
    Dim strVsblRngAddr  As String
    Dim ChtAreaOldColor As Long
    Dim objCount        As Long
    Dim objLoop         As Long
    Dim blnLegend       As Boolean
    Dim NoColor         As Long
    
    
    Const ZoomInChartAreaFontSize   As Long = 20
    Const ZoomInWidthAdjustment     As Long = 35
    Const ZoomInHeightAdjustment    As Long = 10
    Const ZoomInShapeFontSize       As Long = 20
    Const ZoomInChartAreaColor      As Long = 16777215
    
    Set rngVisible = ActiveWindow.VisibleRange
    strVsblRngAddr = rngVisible.Address
    
    With ChartToZoomInAndOut
        If .Parent.ProtectContents Then
            MsgBox "'" & UCase$(.Parent.Name) & "' is protected. Unprotect the sheet and try again", 64, "ExcelFox.com"
            Exit Sub
        End If
    End With
    On Error GoTo QuickExit
    If Len(ChartToZoomInAndOut.ShapeRange.AlternativeText) = 0 Then
        With ChartToZoomInAndOut
            strTemp = CSng(.Left) & ":" & CSng(.Width) & ":" & CSng(.Top) & ":" & CSng(.Height) & "|TRUE"
            strTemp = strTemp & vbLf & "CA FS=" & .Chart.ChartArea.Font.Size & Space(10)
            If .Chart.HasTitle Then strTemp = strTemp & vbLf & "CT FS=" & .Chart.ChartTitle.Font.Size & Space(10)
            If .Chart.Shapes.Count Then
                strShp = "CS FS="
                For Each shpChart In .Chart.Shapes
                    strShp = strShp & ";" & shpChart.TextFrame.Characters.Font.Size
                Next
                strShp = Replace(strShp, "=;", "=") & Space(50)
                strTemp = strTemp & vbLf & strShp
            End If
            strSAold = .Parent.ScrollArea
            strTemp = strTemp & vbLf & "AS SA=" & IIf(Len(strSAold), strSAold & Space(20), "Nill" & Space(20))
            ChtAreaOldColor = ChartToZoomInAndOut.Chart.ChartArea.Interior.Color
            strTemp = strTemp & vbLf & "CA FC=" & ChtAreaOldColor & Space(10)
            strTemp = strTemp & vbLf & " © Krishnakumar @ ExcelFox.com"
            .ShapeRange.AlternativeText = strTemp
        End With
    End If
    
    strAltText = ChartToZoomInAndOut.ShapeRange.AlternativeText
    blnZoomIn = InStr(1, strAltText, "TRUE")
    lngBlnPos = InStr(1, strAltText, "|")
    SplitAddr = Split(rngVisible.Address, ":")
    With ChartToZoomInAndOut.Chart
        NewCAFS = .ChartArea.Font.Size
        If .HasTitle Then NewCTFS = .ChartTitle.Font.Size
        If .Shapes.Count Then
            For lngLoop = 1 To .Shapes.Count
                ReDim Preserve NewCSFS(1 To lngLoop)
                NewCSFS(lngLoop) = CSng(.Shapes(lngLoop).TextFrame.Characters.Font.Size)
            Next
        End If
        Application.GoTo .Parent.TopLeftCell
    End With
    
    If blnZoomIn Then
        With ChartToZoomInAndOut
            .Chart.ChartArea.Font.Size = ZoomInChartAreaFontSize
            .Left = Range(SplitAddr(0)).Left + 1
            .Width = rngVisible.Columns.Width - ZoomInWidthAdjustment
            .Top = Range(SplitAddr(0)).Top + 1
            .Height = rngVisible.Rows.Height - ZoomInHeightAdjustment
            .ShapeRange.AlternativeText = Replace(strAltText, "TRUE", "FALSE")
            If Not .BringToFront Then .BringToFront
            .Parent.ScrollArea = vbNullString
            .Parent.ScrollArea = strVsblRngAddr
        End With
        strAltText = ChartToZoomInAndOut.ShapeRange.AlternativeText
        If ChartToZoomInAndOut.Chart.ChartArea.Interior.Color = -2 Then
            ChartToZoomInAndOut.Chart.ChartArea.Interior.Color = ZoomInChartAreaColor
        End If
        OldCAFS = CSng(Trim$(Mid$(strAltText, InStr(1, strAltText, "CA FS=") + 6, 10)))
        If OldCAFS <> NewCAFS Then _
        strAltText = Replace(strAltText, "CA FS=" & OldCAFS, "CA FS=" & NewCAFS)
    
        If InStr(1, strAltText, "CT FS=") Then
            OldCTFS = CSng(Trim(Mid$(strAltText, InStr(1, strAltText, "CT FS=") + 6, 10)))
            If OldCTFS <> NewCTFS Then _
            strAltText = Replace(strAltText, "CT FS=" & OldCTFS, "CT FS=" & NewCTFS)
        End If
    
        If InStr(1, strAltText, "CS FS=") Then
            OldCSFS = Trim(Mid$(strAltText, InStr(1, strAltText, "CS FS=") + 6, 50))
            SplitCSFS = Split(OldCSFS, ";")
            For lngLoop = 1 To ChartToZoomInAndOut.Chart.Shapes.Count
                If lngLoop <= 1 + UBound(SplitCSFS) Then
                    If SplitCSFS(lngLoop - 1) <> NewCSFS(lngLoop) Then
                        strNewCSFS = strNewCSFS & ";" & NewCSFS(lngLoop)
                    Else
                        strNewCSFS = strNewCSFS & ";" & NewCSFS(lngLoop)
                    End If
                Else
                    strNewCSFS = strNewCSFS & ";" & NewCSFS(lngLoop)
                End If
                ChartToZoomInAndOut.Chart.Shapes(lngLoop).TextFrame.Characters.Font.Size = ZoomInShapeFontSize
            Next
            If Len(strNewCSFS) > 1 Then strNewCSFS = Mid$(strNewCSFS, 2)
            strAltText = Replace(strAltText, "CS FS=" & OldCSFS, "CS FS=" & strNewCSFS)
        End If
        ChartToZoomInAndOut.ShapeRange.AlternativeText = strAltText
        If Not blnShowShapes Then
            strObjNames = ""
            For Each objObject In ActiveSheet.Shapes
                If objObject.Visible Then strObjNames = strObjNames & "|" & objObject.Name
                Select Case objObject.Type
                    Case 3
                    Case 8
                        If objObject.FormControlType <> 7 Then objObject.Visible = 0
                Case Else
                    objObject.Visible = 0
                End Select
            Next
        End If
    Else
        SplitText = Split(Split(strAltText, "|")(0), ":")
        With ChartToZoomInAndOut
            .Left = SplitText(0)
            .Width = SplitText(1)
            .Top = SplitText(2)
            .Height = SplitText(3)
            .ShapeRange.AlternativeText = Replace(strAltText, "FALSE", "TRUE")
            If Not .SendToBack Then .SendToBack
            strAltText = ChartToZoomInAndOut.ShapeRange.AlternativeText
            .Chart.ChartArea.Font.Size = CSng(Trim(Mid$(strAltText, InStr(1, strAltText, "CA FS=") + 6, 10)))
            .Chart.ChartArea.Interior.Color = CLng(Trim(Mid$(strAltText, InStr(1, strAltText, "CA FC=") + 6, 10)))
            If .Chart.HasTitle Then .Chart.ChartTitle.Font.Size = CSng(Trim(Mid$(strAltText, InStr(1, strAltText, "CT FS=") + 6, 10)))
            If .Chart.Shapes.Count Then
                If InStr(1, strAltText, "CS FS=") Then
                    OldCSFS = Trim(Mid$(strAltText, InStr(1, strAltText, "CS FS=") + 6, 50))
                    SplitCSFS = Split(OldCSFS, ";")
                    For lngLoop = 0 To UBound(SplitCSFS)
                        .Chart.Shapes(lngLoop + 1).TextFrame.Characters.Font.Size = CSng(SplitCSFS(lngLoop))
                    Next
                End If
            End If
            strSAold = Trim(Mid$(strAltText, InStr(1, strAltText, "AS SA=") + 6, 50))
            strSAold = Trim$(Left$(strSAold, InStr(1, strSAold & Chr(32), Chr(32))))
            If strSAold <> "Nill" Then
                .Parent.ScrollArea = strSAold
            Else
                .Parent.ScrollArea = ""
            End If
            .ShapeRange.AlternativeText = ""
        End With
        For Each objObject In ActiveSheet.Shapes
            If InStr(1, strObjNames, objObject.Name) Then objObject.Visible = 1
        Next
    End If
QuickExit:
    If Err.Number <> 0 Then
        MsgBox "Error #" & Err.Number & vbLf & Err.Description, 64, "ExcelFox.com"
        ChartToZoomInAndOut.ShapeRange.AlternativeText = ""
        Err.Clear: On Error GoTo 0
    End If
End Sub
 
Upvote 0
Maybe, I am missing something but, clearly, KrishnaKumar did not want to post the code here. Why would you do that?
iknowu99 said:
got it...
nice job...i would show some certificates on that site ...wasn't sure if i was downloadin malicious macro there...thanks for this code:
Code: 
Sub Chart1_Click()
    ZoomChartInAndOut ActiveSheet.ChartObjects(Application.Caller)
End Sub
Sub Chart2_Click()
    ZoomChartInAndOut ActiveSheet.ChartObjects(Application.Caller)
End Sub
Sub Chart3_Click()
    ZoomChartInAndOut ActiveSheet.ChartObjects(Application.Caller)
End Sub

Public strObjNames As String
Sub ZoomChartInAndOut(ByRef ChartToZoomInAndOut As ChartObject, Optional ByVal blnShowShapes As Boolean = 0)
    '// Author      : Krishnakumar @ ExcelFox.com
    '// Created on  : 23-Mar-2011
    '// Purpose     : Resize Chart
    
    Dim blnZoomIn       As Boolean
    Dim lngBlnPos       As Long
    Dim lngLoop         As Long
    Dim rngVisible      As Range
    Dim objObject       As Object
    Dim shpChart        As Shape
    Dim strTemp         As String
    Dim strAltText      As String
    Dim strShp          As String
    Dim OldCSFS         As String
    Dim OldCAFS         As Single
    Dim NewCAFS         As Single
    Dim OldCTFS         As Single
    Dim NewCTFS         As Single
    Dim NewCSFS()       As Single
    Dim SplitText       As Variant
    Dim SplitAddr       As Variant
    Dim SplitCSFS       As Variant
    Dim strNewCSFS      As String
    Dim strSAold        As String
    Dim strVsblRngAddr  As String
    Dim ChtAreaOldColor As Long
    Dim objCount        As Long
    Dim objLoop         As Long
    Dim blnLegend       As Boolean
    Dim NoColor         As Long
    
    
    Const ZoomInChartAreaFontSize   As Long = 20
    Const ZoomInWidthAdjustment     As Long = 35
    Const ZoomInHeightAdjustment    As Long = 10
    Const ZoomInShapeFontSize       As Long = 20
    Const ZoomInChartAreaColor      As Long = 16777215
    
    Set rngVisible = ActiveWindow.VisibleRange
    strVsblRngAddr = rngVisible.Address
    
    With ChartToZoomInAndOut
        If .Parent.ProtectContents Then
            MsgBox "'" & UCase$(.Parent.Name) & "' is protected. Unprotect the sheet and try again", 64, "ExcelFox.com"
            Exit Sub
        End If
    End With
    On Error GoTo QuickExit
    If Len(ChartToZoomInAndOut.ShapeRange.AlternativeText) = 0 Then
        With ChartToZoomInAndOut
            strTemp = CSng(.Left) & ":" & CSng(.Width) & ":" & CSng(.Top) & ":" & CSng(.Height) & "|TRUE"
            strTemp = strTemp & vbLf & "CA FS=" & .Chart.ChartArea.Font.Size & Space(10)
            If .Chart.HasTitle Then strTemp = strTemp & vbLf & "CT FS=" & .Chart.ChartTitle.Font.Size & Space(10)
            If .Chart.Shapes.Count Then
                strShp = "CS FS="
                For Each shpChart In .Chart.Shapes
                    strShp = strShp & ";" & shpChart.TextFrame.Characters.Font.Size
                Next
                strShp = Replace(strShp, "=;", "=") & Space(50)
                strTemp = strTemp & vbLf & strShp
            End If
            strSAold = .Parent.ScrollArea
            strTemp = strTemp & vbLf & "AS SA=" & IIf(Len(strSAold), strSAold & Space(20), "Nill" & Space(20))
            ChtAreaOldColor = ChartToZoomInAndOut.Chart.ChartArea.Interior.Color
            strTemp = strTemp & vbLf & "CA FC=" & ChtAreaOldColor & Space(10)
            strTemp = strTemp & vbLf & " © Krishnakumar @ ExcelFox.com"
            .ShapeRange.AlternativeText = strTemp
        End With
    End If
    
    strAltText = ChartToZoomInAndOut.ShapeRange.AlternativeText
    blnZoomIn = InStr(1, strAltText, "TRUE")
    lngBlnPos = InStr(1, strAltText, "|")
    SplitAddr = Split(rngVisible.Address, ":")
    With ChartToZoomInAndOut.Chart
        NewCAFS = .ChartArea.Font.Size
        If .HasTitle Then NewCTFS = .ChartTitle.Font.Size
        If .Shapes.Count Then
            For lngLoop = 1 To .Shapes.Count
                ReDim Preserve NewCSFS(1 To lngLoop)
                NewCSFS(lngLoop) = CSng(.Shapes(lngLoop).TextFrame.Characters.Font.Size)
            Next
        End If
        Application.GoTo .Parent.TopLeftCell
    End With
    
    If blnZoomIn Then
        With ChartToZoomInAndOut
            .Chart.ChartArea.Font.Size = ZoomInChartAreaFontSize
            .Left = Range(SplitAddr(0)).Left + 1
            .Width = rngVisible.Columns.Width - ZoomInWidthAdjustment
            .Top = Range(SplitAddr(0)).Top + 1
            .Height = rngVisible.Rows.Height - ZoomInHeightAdjustment
            .ShapeRange.AlternativeText = Replace(strAltText, "TRUE", "FALSE")
            If Not .BringToFront Then .BringToFront
            .Parent.ScrollArea = vbNullString
            .Parent.ScrollArea = strVsblRngAddr
        End With
        strAltText = ChartToZoomInAndOut.ShapeRange.AlternativeText
        If ChartToZoomInAndOut.Chart.ChartArea.Interior.Color = -2 Then
            ChartToZoomInAndOut.Chart.ChartArea.Interior.Color = ZoomInChartAreaColor
        End If
        OldCAFS = CSng(Trim$(Mid$(strAltText, InStr(1, strAltText, "CA FS=") + 6, 10)))
        If OldCAFS <> NewCAFS Then _
        strAltText = Replace(strAltText, "CA FS=" & OldCAFS, "CA FS=" & NewCAFS)
    
        If InStr(1, strAltText, "CT FS=") Then
            OldCTFS = CSng(Trim(Mid$(strAltText, InStr(1, strAltText, "CT FS=") + 6, 10)))
            If OldCTFS <> NewCTFS Then _
            strAltText = Replace(strAltText, "CT FS=" & OldCTFS, "CT FS=" & NewCTFS)
        End If
    
        If InStr(1, strAltText, "CS FS=") Then
            OldCSFS = Trim(Mid$(strAltText, InStr(1, strAltText, "CS FS=") + 6, 50))
            SplitCSFS = Split(OldCSFS, ";")
            For lngLoop = 1 To ChartToZoomInAndOut.Chart.Shapes.Count
                If lngLoop <= 1 + UBound(SplitCSFS) Then
                    If SplitCSFS(lngLoop - 1) <> NewCSFS(lngLoop) Then
                        strNewCSFS = strNewCSFS & ";" & NewCSFS(lngLoop)
                    Else
                        strNewCSFS = strNewCSFS & ";" & NewCSFS(lngLoop)
                    End If
                Else
                    strNewCSFS = strNewCSFS & ";" & NewCSFS(lngLoop)
                End If
                ChartToZoomInAndOut.Chart.Shapes(lngLoop).TextFrame.Characters.Font.Size = ZoomInShapeFontSize
            Next
            If Len(strNewCSFS) > 1 Then strNewCSFS = Mid$(strNewCSFS, 2)
            strAltText = Replace(strAltText, "CS FS=" & OldCSFS, "CS FS=" & strNewCSFS)
        End If
        ChartToZoomInAndOut.ShapeRange.AlternativeText = strAltText
        If Not blnShowShapes Then
            strObjNames = ""
            For Each objObject In ActiveSheet.Shapes
                If objObject.Visible Then strObjNames = strObjNames & "|" & objObject.Name
                Select Case objObject.Type
                    Case 3
                    Case 8
                        If objObject.FormControlType <> 7 Then objObject.Visible = 0
                Case Else
                    objObject.Visible = 0
                End Select
            Next
        End If
    Else
        SplitText = Split(Split(strAltText, "|")(0), ":")
        With ChartToZoomInAndOut
            .Left = SplitText(0)
            .Width = SplitText(1)
            .Top = SplitText(2)
            .Height = SplitText(3)
            .ShapeRange.AlternativeText = Replace(strAltText, "FALSE", "TRUE")
            If Not .SendToBack Then .SendToBack
            strAltText = ChartToZoomInAndOut.ShapeRange.AlternativeText
            .Chart.ChartArea.Font.Size = CSng(Trim(Mid$(strAltText, InStr(1, strAltText, "CA FS=") + 6, 10)))
            .Chart.ChartArea.Interior.Color = CLng(Trim(Mid$(strAltText, InStr(1, strAltText, "CA FC=") + 6, 10)))
            If .Chart.HasTitle Then .Chart.ChartTitle.Font.Size = CSng(Trim(Mid$(strAltText, InStr(1, strAltText, "CT FS=") + 6, 10)))
            If .Chart.Shapes.Count Then
                If InStr(1, strAltText, "CS FS=") Then
                    OldCSFS = Trim(Mid$(strAltText, InStr(1, strAltText, "CS FS=") + 6, 50))
                    SplitCSFS = Split(OldCSFS, ";")
                    For lngLoop = 0 To UBound(SplitCSFS)
                        .Chart.Shapes(lngLoop + 1).TextFrame.Characters.Font.Size = CSng(SplitCSFS(lngLoop))
                    Next
                End If
            End If
            strSAold = Trim(Mid$(strAltText, InStr(1, strAltText, "AS SA=") + 6, 50))
            strSAold = Trim$(Left$(strSAold, InStr(1, strSAold & Chr(32), Chr(32))))
            If strSAold <> "Nill" Then
                .Parent.ScrollArea = strSAold
            Else
                .Parent.ScrollArea = ""
            End If
            .ShapeRange.AlternativeText = ""
        End With
        For Each objObject In ActiveSheet.Shapes
            If InStr(1, strObjNames, objObject.Name) Then objObject.Visible = 1
        Next
    End If
QuickExit:
    If Err.Number <> 0 Then
        MsgBox "Error #" & Err.Number & vbLf & Err.Description, 64, "ExcelFox.com"
        ChartToZoomInAndOut.ShapeRange.AlternativeText = ""
        Err.Clear: On Error GoTo 0
    End If
End Sub
Click to expand...
 
Upvote 0
Didn't mean to offend anyone

If krishnakumar didn't want to share he wouldnt provide the link....

It is understandable that when there is confidentiality it is company proprietary. I took this as another VBA lesson from the programming expert. Again sorry if that wasn't your intention
 
Upvote 0
Krish

Does this code work for charts embedded into a sheet - or does it have to be a chart Tab.

2ndly - dum question - does this changes the axes of your charts - or does it simply change the size - guess I could study code more - but easier to ask - ;). is Excel fox a new site?
 
Upvote 0
You must log in or register to reply here.

Similar threads

B
  • Question
VBA code for zooming data validation menus but in 365 shared online
Replies
1
Views
76
myall_blues
myall_blues
N
  • Question
Dashboards
Replies
1
Views
120
awoohaw
awoohaw
O
  • Question
Creating a Graph/Chart needing TWO secondary axis options for a combination of Clustered and Stacked Graph Columns
Replies
0
Views
457
OrangeJuice
O
pbornemeier
  • Question
VBA Hangs While Producing Complex Graph
Replies
1
Views
175
frabulator
frabulator
P
  • Question
Chart types on the same axis, different 0.0 spots
Replies
0
Views
119
PuckMark19
P

Forum statistics

Threads
1,216,201
Messages
6,129,487
Members
449,512
Latest member
Wabd

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