dynamisches Diagramm
23.07.2004 09:19:04
Christoph M
Hallo Daniel,
ich hab den Code von Joseph - entsprechend angepasst.
Da es bei mir manchmal zu einem Fehler kam, hab ich noch eine Abfangung eingebaut.
so müsste es laufen, den Rest kannst du ja, wie du schreibst, alleine.
Gruß
Christoph
(Sepp möge mir den Umbau verzeihen...jeder hat halt 'ne andere "Schreibe")
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim myDia As Chart
Dim rngA As Range, rngB As Range, rngS As Range
Dim strAdr As String, strXAdr As String
Dim minY As Integer, col As Integer
If Intersect(Target, [A2,A4,A6]) Is Nothing Then Exit Sub
With Me
Set myDia = .ChartObjects("Diagramm 1").Chart
col = .Range("A7")
End With
With Sheets("Quadranten")
Set rngA = .Range("A:A").Find(CDate(Me.Range("A2")), LookAt:=xlWhole)
Set rngB = .Range("A:A").Find(CDate(Me.Range("A4")), LookAt:=xlWhole)
If Not rngA Is Nothing And Not rngB Is Nothing Then
minY = Round(Application.Min(.Range(.Cells(rngA.Row, col), .Cells(rngB.Row, col))), 0)
strAdr = .Range(.Cells(rngA.Row, col), .Cells(rngB.Row, col)).Address
strXAdr = .Range(.Cells(rngA.Row, 1), .Cells(rngB.Row, 1)).Address
Set rngS = Union(.Range(.Cells(rngA.Row, 1), .Cells(rngB.Row, 1)), _
.Range(.Cells(rngA.Row, col), .Cells(rngB.Row, col)))
On Error Resume Next
With myDia
.SetSourceData Source:=rngS, PlotBy:=xlColumns
.SeriesCollection(1).Values = "=Quadranten!" & strAdr
.SeriesCollection(1).XValues = "=Quadranten!" & strXAdr
.ChartTitle.Characters.Text = "Daten von " & rngA & " bis " & rngB & _
", Quelle = """ & Me.Range("A6") & """"
.Axes(xlValue).MinimumScale = minY
End With
End If
End With
End Sub