Точечная диаграмма Excel для отображения перемычки в выбранной точке

Question

Есть ли способ настроить Excel 2010 для отображения перемычки в выбранной точке на точечной диаграмме? Поведение по умолчанию - показывать всплывающую подсказку со значением точки при наведении курсора мыши. При щелчке по точке было бы неплохо показать перекладину (которая простирается до границы, облегчает чтение шкалы).

Answer 1

Если я правильно понимаю вопрос, вы ищете что-то подобное, когда щелкаете точку данных на точечной диаграмме?

Роберт Мандигл (Robert Mundigl) описывает, как это сделать, в своем блоге «Четко и просто», применяя технику Джона Пельтье. Это работает очень хорошо.

Читайте блог для полной информации. Я только суммировал ключевые шаги ниже.

---

Роберт Мандигл Техника - Резюме

Сначала установите следующие именованные диапазоны

Затем включите панели ошибок

Теперь мы добавляем горизонтальные и вертикальные полосы ошибок в ряд данных диаграммы, используя стандартную функциональность Excel (инструменты ленты Chart | Tab Chart и Layout | Error Bars. В диалоговом окне «Форматировать панели ошибок» мы выбираем «Сумма ошибки» «Пользовательская» и задаем значения, используя сумму панели ошибок с именем формулы (myEB_X_Pos и т.д.)

Добавьте код VBA

Если вы никогда ранее не использовали VBA, прочитайте это вступительное руководство по VBA.

В редакторе Visual Basic (нажмите Alt+F11 для доступа к этому), вставьте модуль с именем modAppEvent.

' ----------------------------------------------------------------------------------------------------------------------------------
'   VBA Project:    Interactive Drop Lines on Excel Charts
'   Module:         modAppEvent
'   Author:         Jon Peltier
'   Copyright:      © 2012 by Jon Peltier, Peltier Technical Services Inc, www.peltiertech.com. All rights reserved.
'   Last edit:      27-October-2012
'   Purpose:        Turn application events on and off
' ----------------------------------------------------------------------------------------------------------------------------------
Option Explicit

Public my_objSheet As clsAppEvent

Sub AppEventsOn()
    On Error Resume Next
    Set my_objSheet = New clsAppEvent
    Set my_objSheet.xlApp = Application
End Sub

Sub AppEventsOff()
    On Error Resume Next
    Set my_objSheet.xlApp = Nothing
End Sub

добавить еще один модуль с именем modChartEvent

' ----------------------------------------------------------------------------------------------------------------------------------
'   VBA Project:    Interactive Drop Lines on Excel Charts
'   Module:         modChartEvent
'   Author:         Jon Peltier
'   Copyright:      © 2012 by Jon Peltier, Peltier Technical Services Inc, www.peltiertech.com. All rights reserved.
'   Last edit:      27-October-2012
'   Purpose:        Setting and resetting chart events
' ----------------------------------------------------------------------------------------------------------------------------------
Option Explicit
Option Base 1

Public myCharts() As New clsChartEvent

Sub Set_All_Charts()
Dim obj_cht As ChartObject
Dim int_chartnum As Integer

    On Error Resume Next
    If ActiveSheet.ChartObjects.Count > 0 Then
        ReDim myCharts(ActiveSheet.ChartObjects.Count)
        int_chartnum = 1
        For Each obj_cht In ActiveSheet.ChartObjects
            Set myCharts(int_chartnum).myEmbeddedChart = obj_cht.Chart
            int_chartnum = int_chartnum + 1
        Next
    End If

End Sub

Sub Reset_All_Charts()
Dim int_chartnum As Integer

    On Error Resume Next
    int_chartnum = UBound(myCharts)
    For int_chartnum = 1 To UBound(myCharts)
        Set myCharts(int_chartnum).myEmbeddedChart = Nothing
    Next

End Sub

Sub ActivateSheet(ByVal Sh As Object)
    Set_All_Charts
End Sub

и третий называется modDropLines

' ----------------------------------------------------------------------------------------------------------------------------------
'   VBA Project:    Interactive Drop Lines on Excel Charts
'   Module:         modDropDownLines
'   Author:         Robert Mundigl
'   Copyright:      © 2012 by Robert Mundigl, www.clearlyandsimply.com. All rights reserved.
'   Last edit:      27-October-2012
'   Purpose:        Change the value of the defined named range based on the data point the user clicked on
' ----------------------------------------------------------------------------------------------------------------------------------
Option Explicit

Sub DropLines(lngDataPoint As Long)
' Update the named range after user clicked on a data point
Dim rngCurrentCell As Range

    ' Store the active cell
    Set rngCurrentCell = ActiveCell
    ' Update the selected data point
    ActiveWorkbook.Names("myDataPoint").Value = lngDataPoint
    ' Go back to the cell (prevent Excel from activating the data series)
    rngCurrentCell.Select

End Sub

Затем добавьте модуль класса с именем clsAppEvent

' ----------------------------------------------------------------------------------------------------------------------------------
'   VBA Project:    Interactive Drop Lines on Excel Charts
'   Module:         clsAppEvent
'   Author:         Jon Peltier
'   Copyright:      © 2012 by Jon Peltier, Peltier Technical Services Inc, www.peltiertech.com. All rights reserved.
'   Last edit:      27-October-2012
'   Purpose:        Application Event Class Module
' ----------------------------------------------------------------------------------------------------------------------------------
Option Explicit

Public WithEvents xlApp As Excel.Application

Private Sub xlApp_SheetActivate(ByVal obj_Sh As Object)
    ActivateSheet obj_Sh
End Sub

Private Sub xlApp_SheetDeactivate(ByVal obj_Sh As Object)
    Reset_All_Charts
End Sub

а другой называется clsChartEvent

' ----------------------------------------------------------------------------------------------------------------------------------
'   VBA Project:    Interactive Drop Lines on Excel Charts
'   Module:         clsChartEvent
'   Author:         Jon Peltier
'   Copyright:      © 2012 by Jon Peltier, Peltier Technical Services Inc, www.peltiertech.com. All rights reserved.
'   Edited by:      Robert Mundigl
'   Last edit:      27-October-2012
'   Purpose:        Handle clicks on a data point of an embedded chart
' ----------------------------------------------------------------------------------------------------------------------------------
Option Explicit

Public WithEvents myEmbeddedChart As Chart

Private Sub myEmbeddedChart_MouseDown(ByVal Button As Long, ByVal Shift As Long, ByVal X As Long, ByVal Y As Long)
Dim lng_Element As Long
Dim lng_Argument1 As Long
Dim lng_Argument2 As Long

    If Button = xlPrimaryButton Then
        myEmbeddedChart.GetChartElement X, Y, lng_Element, lng_Argument1, lng_Argument2
        If lng_Element = xlSeries And lng_Argument2 > 0 Then
            DropLines lng_Argument2
        End If
    End If

End Sub

Наконец в модуле ThisWorkbook добавить

' ----------------------------------------------------------------------------------------------------------------------------------
'   VBA Project:    Interactive Drop Lines on Excel Charts
'   Module:         Workbook code
'   Author:         Jon Peltier
'   Copyright:      © 2012 by Jon Peltier, Peltier Technical Services Inc, www.peltiertech.com. All rights reserved.
'   Last edit:      27-October-2012
'   Purpose:        Initialize and clean up when opening or closing the workbook
' ----------------------------------------------------------------------------------------------------------------------------------
Option Explicit

Private Sub Workbook_Open()
    AppEventsOn
    Set_All_Charts
End Sub

Private Sub Workbook_BeforeClose(Cancel As Boolean)
    AppEventsOff
End Sub

---

Скачать Zip

Роберт добавил zip-файл для загрузки, содержащий различные примеры, которые помогут вам начать работу (и это проще, чем копировать и вставлять все эти VBA).