VBA/Excel/Access/Word/Excel/Chart Event

Материал из VB Эксперт
Версия от 12:47, 26 мая 2010; Admin (обсуждение | вклад) (1 версия)
(разн.) ← Предыдущая | Текущая версия (разн.) | Следующая → (разн.)
Перейти к: навигация, поиск

Chart_Deactivate procedure also displays a message only when the chart sheet is deactivated:

 
Private Sub Chart_Deactivate()
    msg = "Thanks for viewing the chart."
    MsgBox msg, , ActiveWorkbook.Name
End Sub



Chart double click event

 
     Private Sub Chart_BeforeDoubleClick(ByVal ElementID As Long, _
                         ByVal Arg1 As Long, ByVal Arg2 As Long, Cancel As Boolean)
         Dim seSeries As Series
         Select Case ElementID
         Case xlLegend
             Me.HasLegend = False
             Cancel = True
         Case xlPlotArea
             Me.HasLegend = True
             Cancel = True
         Case xlSeries
             Set seSeries = Me.SeriesCollection(Arg1)
             If Arg2 = -1 Then
                 With seSeries.Border
                    If .ColorIndex = xlColorIndexAutomatic Then
                        .ColorIndex = 1
                    Else
                        .ColorIndex = (.ColorIndex Mod 56) + 1
                    End If
                 End With
             Else
                 With seSeries.Points(Arg2)
                    .HasDataLabel = Not .HasDataLabel
                 End With
             End If
             Cancel = True
         End Select
     End Sub



Embedded Chart Mouse Events

 
Private Sub xlChart_MouseDown(ByVal Button As Long, ByVal Shift As Long,ByVal x As Long, ByVal y As Long)
    If Button = 1 Then
       xlChart.Axes(xlValue).MaximumScale = xlChart.Axes(xlValue).MaximumScale - 50
    End If
    If Button = 2 Then
       xlChart.Axes(xlValue).MaximumScale = xlChart.Axes(xlValue).MaximumScale + 50
    End If
End Sub



Events with Chart Sheets

 
Private Sub Chart_Select(ByVal ElementID As Long, ByVal Arg1 As Long, _
                         ByVal Arg2 As Long)
    If ElementID = 3 And Arg2 > 0 Then
        With ActiveChart.SeriesCollection(Arg1).Points(Arg2)
            .ApplyDataLabels Type:=xlShowValue
        End With
     End If
End Sub



Events with Embedded Charts

 
Private Sub myChartClass_DragOver()
    Range("A1").Value = "You have activated the DragOver() sub procedure."
End Sub
Private Sub myChartClass_DragPlot()
    Range("A2").Value = "You have activated the DragPlot() sub procedure."
End Sub
Private Sub myChartClass_MouseDown(ByVal Button As Long, ByVal Shift As Long, ByVal x As Long, ByVal y As Long)
    Range("A3").Value = "You have activated the MouseDown() sub procedure."
End Sub
Private Sub myChartClass_MouseMove(ByVal Button As Long, _
           ByVal Shift As Long, ByVal x As Long, ByVal y As Long)
    Range("L34").Value = "You have activated the MouseMove() sub procedure."
End Sub
Private Sub myChartClass_MouseUp(ByVal Button As Long, ByVal Shift As Long, ByVal x As Long, ByVal y As Long)
    Range("L34").Value = "You have activated the MouseUp() sub procedure."
End Sub
Private Sub myChartClass_Select(ByVal ElementID As Long,ByVal Arg1 As Long, ByVal Arg2 As Long)
    If ElementID = 3 And Arg2 > 0 Then
        ActiveChart.SeriesCollection(Arg1).Points(Arg2).ApplyDataLabels Type:=xlShowValue
    End If
End Sub
Private Sub myChartClass_Resize()
    Range("A2").Value = "You have activated the Resize() sub procedure."
End Sub
Private Sub myChartClass_SeriesChange(ByVal SeriesIndex As Long,ByVal PointIndex As Long)
        Range("A3").Value = "You have activated the SeriesChange() sub procedure."
End Sub



hides the legend when it is double-clicked; double-clicking either axis brings back the legend:

 
Private Sub MyChartClass_BeforeDoubleClick(ByVal ElementID As Long,ByVal Arg1 As Long, ByVal Arg2 As Long, Cancel As Boolean)
    Select Case ElementID
        Case xlLegend
            Me.HasLegend = False
            Cancel = True
        Case xlAxis
            Me.HasLegend = True
            Cancel = True
    End Select
End Sub



The Chart_Select procedure listed next is executed whenever an item on the chart is selected:

 
Private Sub Chart_Select(ByVal ElementID As Long, _
  ByVal Arg1 As Long, ByVal Arg2 As Long)
    Select Case ElementID
        Case xlChartArea: Id = "ChartArea"
        Case xlChartTitle: Id = "ChartTitle"
        Case xlPlotArea: Id = "PlotArea"
        Case xlLegend: Id = "Legend"
        Case xlFloor: Id = "Floor"
        Case xlWalls: Id = "Walls"
        Case xlCorners: Id = "Corners"
        Case xlDataTable: Id = "DataTable"
        Case xlSeries: Id = "Series"
        Case xlDataLabel: Id = "DataLabel"
        Case xlTrendline: Id = "Trendline"
        Case xlErrorBars: Id = "ErrorBars"
        Case xlXErrorBars: Id = "XErrorBars"
        Case xlYErrorBars: Id = "YErrorBars"
        Case xlLegendEntry: Id = "LegendEntry"
        Case xlLegendKey: Id = "LegendKey"
        Case xlAxis: Id = "Axis"
        Case xlMajorGridlines: Id = "MajorGridlines"
        Case xlMinorGridlines: Id = "MinorGridlines"
        Case xlAxisTitle: Id = "AxisTitle"
        Case xlUpBars: Id = "UpBars"
        Case xlDownBars: Id = "DownBars"
        Case xlSeriesLines: Id = "SeriesLines"
        Case xlHiLoLines: Id = "HiLoLines"
        Case xlDropLines: Id = "DropLines"
        Case xlRadarAxisLabels: Id = "RadarAxisLabels"
        Case xlShape: Id = "Shape"
        Case xlNothing: Id = "Nothing"
        Case Else: Id = "Some unknown thing"
    End Select
    MsgBox "Selection type:" & Id
End Sub



Understanding Chart Events

 
Private Sub Chart_Activate()
    msg = "Hello " & Application.userName & vbCrLf & vbCrLf
    msg = msg & "You are now viewing the six-month sales "
    msg = msg & "summary for Products 1-3." & vbCrLf & vbCrLf
    msg = msg & "Click on items in the chart to find out what they are."
    MsgBox msg, vbInformation, ActiveWorkbook.name
End Sub



zooms in on a left mouse click and zooms out on a right mouse click.

 
Private Sub MyChartClass_MouseDown(ByVal Button As Long, ByVal Shift _
    As Long, ByVal x As Long, ByVal y As Long)
    If Button = 1 Then
        ActiveChart.Axes(xlValue).MaximumScale = ActiveChart.Axes(xlValue).MaximumScale - 50
    End If
    If Button = 2 Then
       ActiveChart.Axes(xlValue).MaximumScale = ActiveChart.Axes(xlValue).MaximumScale + 50
    End If
End Sub