Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
624to628
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
624to628
624to628
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

Diagramm: Vorhandendes Makro ändern

Diagramm: Vorhandendes Makro ändern
20.06.2005 16:28:57
Daniel
Guten Tag Allerseits!
Vor einiger Zeit hat mir hier jemand im Forum ein Makro geschrieben, das x/y Werte für eine ausgewählte Zeile, die per DropDown Menü angesteuert wird, zweier Tabellenblätter anzeigt.
Vereinfachend füge ich die Datei hier mal ein:
https://www.herber.de/bbs/user/24020.xls
Und zwar hätte ich gerne Folgendes geändert:
- es soll ein Gitterkreuz bei x/y = 100 eingefügt werden. (siehe schwarze Linien im Bild)
- Es soll eine Winkelhalbierende eingefügt werden. (siehe rote Linie im Bild).
Eine Winkelhalbierende hat die Koordinaten 0/0, 1/1, 2/2 usw.
http://www.equitypm.com/TheJan6.gif
Es wäre sehr nett, wenn mir jemand das Makro so abändern könnte.
Vielen Dank,
Daniel

4
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
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

Anzeige
AW: Diagramm: Vorhandendes Makro ändern
23.06.2005 15:34:13
Daniel
Hallo!
Also, das mit der Koordinaten scheint gut geklappt zu haben.
Auch ist jetzt ein Gitternetz da. Allerdings wollté ich gerne, dass
IMMER bei genau 100/100 ein "Gitter" ist.
Wie geht das?
Vielen Dank für die Hilfe,
Daniel
noch offen.... o.T.
23.06.2005 16:28:23
Daniel
....
AW: noch offen.... o.T.
24.06.2005 10:10:25
Galenzo
ääh? - versteh ich irgendwie nicht.
ich dachte, du wolltest genau in der Mitte ein Kreuz?
wenn immer bei 100/100 ein Kreuz sein soll, dann geht das wohl mit dem Gitternetz so nicht (dann wäre ja auch wieder bei 200/200 eins usw.)
dann solltest du einen anderen Weg gehen: Schau dir mal im Code an, wie die Diagonale erstellt wird. Nach diesem Schema fügst du nun selber 2 weitere Reihen hinzu - eine für die Senkrechte, eine für die Waagerechte. Jede Reihe hat (wie die Diagonale) 2 Punkte. Für diese Punkte gibst du die Koordinaten vor. Das dürfte sich bei den Minimum-Werten einfach gestalten - das ist ja immer 100 bzw. 0. Für die Max-Werte der Reihen ist eine Koordinate wiederum 100, für die andere kannst du den Max-Wert der Diagonalen verwenden.
Ich denke, das bekommst du hin...
Viel Erfolg!
(wenn nicht, dann bitte einen neuen Task mit der Beispielsmappe aktueller Stand)
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige