AW: Bereich bestimmen
20.05.2005 23:00:01
axel
Hallo Martin,
danke für Deine Mühe. Ich versteh zwar nicht so richtig, worum es in der Auseinandersetzung zwischen Dir und Hajo geht. Ich erwarte hier wirklich auch keine Komplettlösung meines Problems. Aber manchmal gehts halt auch nicht weiter. Ich bin so froh, dass es dieses Forum gibt und dass einem völig unbekannte Leute uneigennützig weiterhelfen. Meine Programmierkenntnisse sind noch ziemlich rudimentär (vor ein paar Jahren hatte ich mal Turbopascal an der Schule und ein bisschen Delphi, aber davon ist nicht viel hängengeblieben). Ich hatte das Problem hier schonmal angesprochen, damals konnte mir "Cardexperte" weiterhelfen. Ich dachte ich komm dann allein zur Lösung, aber ich schaffs nicht.
Ich kann den Code mal hier posten. Aber mittlerweile habe ich soviel drin rumprobiert, hoffentlich verstehst Du, was ich damit machen will und es verwirrt nicht so sehr. Es geht eigentlich um eine Diagrammerstellung mit Werten aus 3 Tabellen.
Achso, das "Activate" hab ich einfach aus Lars Code übernommen. Ich habs auch ohne probiert, aber das hat mich genauso wenig weitergebracht.
Sub Abfrage()
If MsgBox("Diagrammerstellung?", vbQuestion + vbYesNo, "Hallo!") = vbNo Then
MsgBox " Ende...", vbExclamation
End 'Programm wird beendet
Else
Call Diagrammerstellung
End If
End Sub
Sub Diagrammerstellung()
' Diagrammerstellung Makro
' Makro am 24.04.2005 von aufgezeichnet
' Tastenkombination: Strg+a
Dim Geschwvektor As Range
Dim Spaltenauswahl As Range
Dim sim As Range
Dim Vergleich As Range
Dim Reihe As Range
Set Geschwvektor = Application.InputBox( _
prompt:="Auswahl des Geschwindigkeitsvektors.", _
Title:="Auswahl des Geschwindigkeitsvektors", Type:=8)
Set Spaltenauswahl = Application.InputBox( _
prompt:="Für Anzahl der Diagramme bitte entsprechende Anzahl Zellen auswählen.", _
Title:="Auswahl der Spalten", Type:=8)
Set sim = Application.InputBox( _
prompt:="Auswahl Zelle Start Werte", _
Title:="Auswahl der Zelle", Type:=8)
Set Vergleich = Application.InputBox( _
prompt:="Auswahl Zelle Start Vergleich", _
Title:="Auswahl der Zelle", Type:=8)
Dim cell As Object
Dim b As Integer
b = 0
For Each cell In Spaltenauswahl
b = b + 1
Next cell
Dim cell2 As Object
Dim a As Integer
a = 0
For Each cell2 In Geschwvektor
a = a + 1
Next cell2
For n = 2 To b
Charts.Add
ActiveChart.ChartType = xlXYScatterLines
' Auswahl Spalten 2 bis n
ActiveChart.SetSourceData Source:=Sheets("Zug").Range(Sheets("Zug").Cells(1, n), _
Sheets("Zug").Cells(a, n)), PlotBy:=xlColumns
ActiveChart.SeriesCollection.NewSeries
ActiveChart.SeriesCollection.NewSeries
ActiveChart.SeriesCollection(1).XValues = Geschwvektor 'das bleibt ja immer gleich
ActiveChart.SeriesCollection(2).XValues = Geschwvektor 'das bleibt ja immer gleich
' Auswahl Spalten 2 bis n werden (Variable n)
'Reihe = "=Zug!R18C" & n & ":R30C" & n
'Das hab ich einfach aus Lars Code rauskopiert.
Cells.Find(What:=sim, After:=sim, LookIn:=xlFormulas, _
LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=True, SearchFormat:=False).Activate
Reihe = Range(Cells(sim.Row, n), Cells(sim.Row + a, n)).Activate
ActiveChart.SeriesCollection(2).Values = Reihe
ActiveChart.SeriesCollection(3).XValues = Geschwvektor
Reihe = Range(Cells(Vergleich, n), Cells(Vergleich + a, n))
ActiveChart.SeriesCollection(3).Values = Reihe
ActiveChart.Location Where:=xlLocationAsObject, Name:="Zug"
With ActiveChart
.HasTitle = False
.Axes(xlCategory, xlPrimary).HasTitle = True
.Axes(xlCategory, xlPrimary).AxisTitle.Characters.Text = _
"Geschwindigkeit [km/h]"
.Axes(xlValue, xlPrimary).HasTitle = False
End With
With ActiveChart
.HasAxis(xlCategory, xlPrimary) = True
.HasAxis(xlValue, xlPrimary) = True
End With
ActiveChart.Axes(xlCategory, xlPrimary).CategoryType = xlAutomatic
ActiveChart.SeriesCollection(3).Select
ActiveChart.SeriesCollection(3).AxisGroup = 2
ActiveChart.Legend.Select
ActiveChart.Axes(xlValue, xlSecondary).Select
Selection.TickLabels.NumberFormat = "0.000E+00"
With ActiveChart.Axes(xlValue, xlSecondary)
.MinimumScaleIsAuto = True
.MaximumScaleIsAuto = True
.MinorUnitIsAuto = True
'.MajorUnit = 0.000001 'Skalierung automatisiert
.Crosses = xlAutomatic
.ReversePlotOrder = False
.ScaleType = xlLinear
.DisplayUnit = xlNone
End With
ActiveChart.Axes(xlValue).MajorGridlines.Select
ActiveChart.Axes(xlValue).MajorGridlines.Select
ActiveChart.Axes(xlValue).Select
ActiveChart.PlotArea.Select
ActiveChart.Axes(xlValue).MajorGridlines.Select
Selection.Delete
ActiveChart.Legend.Select
ActiveChart.Legend.LegendEntries(1).LegendKey.Select
With Selection.Border
.Weight = xlThin
.LineStyle = xlNone
End With
With Selection
.MarkerBackgroundColorIndex = xlAutomatic
.MarkerForegroundColorIndex = xlAutomatic
.MarkerStyle = xlAutomatic
.Smooth = False
.MarkerSize = 5
.Shadow = False
End With
ActiveChart.Legend.LegendEntries(2).LegendKey.Select
With Selection.Border
.Weight = xlThin
.LineStyle = xlAutomatic
End With
With Selection
.MarkerBackgroundColorIndex = xlAutomatic
.MarkerForegroundColorIndex = xlAutomatic
.MarkerStyle = xlNone
.Smooth = False
.MarkerSize = 5
.Shadow = False
End With
Next
MsgBox "Durchlauf beendet"
Exit Sub
End Sub