Diagramm bei Verlassen bzw. Öffnen des Worksheets löschen

[JonasRe]

Hallo zusammen,

ich erzeuge ein Diagramm, welches auf (gefilterten) Daten aus einem anderem Worksheets beruht. Nun möchte ich, dass das Diagramm beim Verlassen bzw. Öffnen des Worksheets gelöscht wird, da ich per Button ein neues Diagramm erzeugen möchte mit den aktuellen (gefilterten Daten). Ich habe es mit Worksheet_Activate() bzw. Worksheet_Deactivate() versucht, jedoch tut sich leider nichts.

Ich hab mit dem Makrorekorder das Diagramm gelöscht und wollte das Sub dazu durch die oben beschrieben Events auslösen.

Code:

Private Sub Worksheet_Deactivate()
   XLöschen
End Sub

Code:

Sub XLöschen()
'
' XLöschen Makro
'

'
   ActiveSheet.ChartObjects(1).Activate
   ActiveChart.Parent.Delete
End Sub

Bin über jede Hilfe dankbar :)

[BoskoBiati]

Hi,

schon mal so probiert:

Code:

Private Sub Worksheet_Deactivate()
   ActiveSheet.ChartObjects(1).Delete
End Sub

[JonasRe]

@BoskoBiati

Ich erhalte dabei einen Laufzeitfehler '1004':
Anwendungs- oder objektdefinierter Fehler.
Ich füge mal noch den Code zur Erzeugung des Graphen hinzu, vielleicht liegt es auch an dem Code...

Code:

'Erzeugung des Graphen und Zuweisung der Daten aus dem Tabellenblatt "Gehaltsdaten"

Sub ErzeugungGraph()

   
Dim data As Worksheet
Dim name As Range
Set data = ActiveWorkbook.Worksheets("Gehaltsdaten")

Application.ScreenUpdating = False
Worksheets("Gehaltsdaten").Activate
ActiveSheet.Shapes.AddChart.Select
ActiveChart.ChartType = xlXYScatter
ActiveChart.SetSourceData Source:=data.Range("A3:AC3000")

ActiveChart.SeriesCollection.NewSeries

   With ActiveChart.SeriesCollection(1)
   
       .XValues = "=Gehaltsdaten!$G$3:$G$800"
       .Values = "=Gehaltsdaten!$AC$3:$AC$800"
       .name = "=Gehaltsdaten!$B$3:$B$800"
       .Trendlines.Add Type:=xlLinear
     
   End With
 
ActiveChart.location Where:=xlLocationAsObject, _
  name:=ThisWorkbook.Worksheets(4).name
 
'Formatierung des Graphen
 
   With ActiveChart
   
       .PlotArea.Format.Fill.ForeColor.ObjectThemeColor = msoThemeColorBackground1
       .HasLegend = False
       .Parent.Height = 600
       .Parent.Width = 1200
       .HasTitle = True
       .HasTitle = False
       .Axes(xlCategory, xlPrimary).HasTitle = True
       .Axes(xlCategory, xlPrimary).AxisTitle.Characters.Text = "Alter"
       .Axes(xlValue, xlPrimary).HasTitle = True
       .Axes(xlValue, xlPrimary).AxisTitle.Characters.Text = "JEK 35H"
       .Axes(xlValue).MinimumScale = 0
       .Axes(xlCategory).MaximumScale = 80
       .SeriesCollection(1).Format.Fill.ForeColor.RGB = rgbBlue
   
       
   End With
   
Worksheets(4).ChartObjects(1).Activate

With ActiveChart

   .Axes(xlValue).AxisTitle.Font.Size = 20
   .Axes(xlCategory).AxisTitle.Font.Size = 20
   .PlotArea.Interior.ColorIndex = 15
   
End With

'Aufrufen des Programms zur Beschriftung der Datenpunkte

     Call BeschriftungDiagramm
       
End Sub

'Beschriftet die Datenpunkte mit je dem ersten Buchstaben des Nach- und Vornamens

Sub BeschriftungDiagramm()

Dim lngPunkt As Long
Dim data As Worksheet

Set data = ActiveWorkbook.Worksheets("Gehaltsdaten")

  With ActiveSheet.ChartObjects(1).Chart.SeriesCollection(1)
     .ApplyDataLabels
     For lngPunkt = 1 To .Points.Count
        .Points(lngPunkt).DataLabel.Text = Left(data.Cells(lngPunkt + 2, 2), 1) & " " & Mid(data.Cells(lngPunkt + 2, 3), 2, 1)
                 
     Next lngPunkt
     
  End With
 
End Sub

[schauan]

Hallöchen,

in welcher Codezeile kommt denn der Fehler?

[JonasRe]

Hallo,
der Fehler tritt direkt in der 2. Zeile auf.