AW: Diagramm: Vorhandendes Makro ändern
23.06.2005 11:06:21
Galenzo
habe mal auf die Schnelle was gebastelt:
kannst du ja noch anpassen/ausbauen
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim myChart As Chart
Dim wks1 As Worksheet
Dim wks2 As Worksheet
Dim intC As Integer
Dim rng As Range
Dim strAdr As String
Dim minX As Long
Dim minY As Long
Dim maxX As Long
Dim maxY As Long
Dim X_Werte, Y_Werte
Dim rng1 As Range
If Not (Target.Address = "$A$2" And IsDate(Target)) Then Exit Sub
Set myChart = Sheets("Matrix").ChartObjects(1).Chart 'Chart der Objectvariablen zuweisen
Set wks1 = Sheets("Defense")
Set wks2 = Sheets("Offense")
Set rng = wks1.Columns("A:A").Find(What:=CDate(Target), LookIn:=xlValues, LookAt:=xlWhole) 'Datum suchen
If rng Is Nothing Then Exit Sub
'Letzte gefüllte Spalte in der gefundenen Zeile feststellen
intC = wks1.Cells(rng.Row, 256).End(xlToLeft).Column
strAdr = wks1.Range(wks1.Cells(rng.Row, 2), wks1.Cells(rng.Row, intC)).Address(ReferenceStyle:=xlR1C1) 'Adresstring erstellen
minX = WorksheetFunction.Min(wks1.Range(wks1.Cells(rng.Row, 2), wks1.Cells(rng.Row, intC)))
minY = WorksheetFunction.Min(wks2.Range(wks2.Cells(rng.Row, 2), wks2.Cells(rng.Row, intC)))
maxX = WorksheetFunction.Max(wks1.Range(wks1.Cells(rng.Row, 2), wks1.Cells(rng.Row, intC)))
maxY = WorksheetFunction.Max(wks2.Range(wks2.Cells(rng.Row, 2), wks2.Cells(rng.Row, intC)))
'Minimumwerte ermittelln
With myChart 'geänderte Werte dem Chart zuweisen
.SeriesCollection(1).XValues = "=Defense!" & strAdr
.SeriesCollection(1).Values = "=Offense!" & strAdr
.Axes(xlCategory).MinimumScale = minX - 5
.Axes(xlValue).MinimumScale = minY - 5
.Axes(xlCategory).MaximumScale = maxX + 10
.Axes(xlValue).MaximumScale = maxY + 10
Dim serDia As Series
On Error Resume Next
.SeriesCollection(2).Delete
X_Werte = Array(.Axes(xlCategory).MinimumScale, .Axes(xlCategory).MaximumScale)
Y_Werte = Array(.Axes(xlValue).MinimumScale, .Axes(xlValue).MaximumScale)
Set serDia = .SeriesCollection.NewSeries
With serDia
.XValues = X_Werte
.Values = Y_Werte
.ChartType = xlXYScatterLines
.Border.ColorIndex = 3
.MarkerStyle = xlNone
End With
With .Axes(xlCategory)
.HasMajorGridlines = True
.HasMinorGridlines = True
.MinorGridlines.Border.ColorIndex = 15
.MajorGridlines.Border.ColorIndex = 1
.MajorUnit = (.MaximumScale - .MinimumScale) / 2
End With
With .Axes(xlValue)
.HasMajorGridlines = True
.HasMinorGridlines = True
.MinorGridlines.Border.ColorIndex = 15
.MajorGridlines.Border.ColorIndex = 1
.MajorUnit = (.MaximumScale - .MinimumScale) / 2
End With
End With
End Sub