AW: Viele Graphen in einem XY Diagramm
08.06.2018 10:18:47
Norman
ich hab das Programm nochmal überarbeitet. Ohne die Schleife läuft es aber mit leider nicht.
Hier erstmal das vollständige Programm:
Sub Datei_import()
' ###### Varibalen initialisieren - START ######
' --- Variablen für Programmablauf ---
Dim zDatei As String ' Zieldatei
Dim zPfad As String ' Zielpfad mit Datei
Dim zPfadH As String ' Zielpfad ohne Datei
Dim startzeile As Long
Dim endzeile As Long
Dim Spaltenzaehler As Integer
Dim i As Long
' --- Variablen für Charts ---
Dim co As ChartObject
Dim cht As Chart
Dim sc1 As SeriesCollection
Dim ser1 As Series
' ###### Varibalen initialisieren - Ende ######
Application.ScreenUpdating = False
'=========================================================================================== _
' ###### Dateien laden und verknüpfen - START ######
' #### Arbeitsdatei ####
With Application.FileDialog(msoFileDialogFilePicker)
.AllowMultiSelect = False
.Title = "Datei wählen"
.InitialFileName = "C:\VBA-Test\" '!!! Pfad anpassen zu - ein Ordner ü _
ber Zielordner
If .Show = -1 Then
zDateiH = .SelectedItems(1)
End If
End With
UserForm1.Show 0
UserForm1.Repaint
Set fso = CreateObject("Scripting.FileSystemObject")
oname = fso.getfilename(zPfadH)
' aktive Datei "Workbooks wird genau der Datei aus dem gebauten Pfad zugeordnet
Workbooks.Open zDateiH ' Zieldatei
zDatei = ActiveWorkbook.Name
' ###### Dateien laden und verknüpfen - START ######
'=========================================================================================== _
' ###### Spalten und Zeilen zählen - START ######
Spaltenzaehler = Workbooks(zDatei).Sheets(1).Cells(1, Columns.Count).End(xlToLeft). _
Column
endzeile = Workbooks(zDatei).Sheets(1).Cells(Rows.Count, 1).End(xlUp).Row
' ###### Spalten und Zeilen zählen - ENDE ######
With Workbooks(zDatei).Sheets(10)
Set co = .ChartObjects.Add(.Range("A5").Left, .Range("A5").Top, 500, 300)
End With
co.Name = "F to s Graph"
Set cht = co.Chart
With Workbooks(zDatei)
With cht
.ChartType = xlXYScatterLinesNoMarkers
.ChartStyle = 241
.HasLegend = True
' ====== Beschriftung Diagramm ======
.HasTitle = True
.ChartTitle.Text = "Kraft-Weg-Diagramm"
' ====== Beschriftung Achsen - START ======
' --- X-Achse ---
.Axes(xlCategory, xlPrimary).HasTitle = True
.Axes(xlCategory, xlPrimary).AxisTitle.Characters.Text = "Weg in mm"
.Axes(xlCategory).TickLabelPosition = xlLow
' --> x-Achsenbeschriftung unter das Diagramm setzen
' --- Y-Achse ---
.Axes(xlValue, xlPrimary).HasTitle = True
.Axes(xlValue, xlPrimary).AxisTitle.Characters.Text = "Kraft in N"
' ====== Beschriftung Achsen - ENDE ======
' ====== Formatierung Achsen - START ======
' --- X-Achse ---
.PlotArea.Select
.Axes(xlCategory).TickLabels.NumberFormat = "#.##0"
' --- Y-Achse ---
.PlotArea.Select
.Axes(xlValue).TickLabels.NumberFormat = "#.##0"
' ====== Formatierung Achsen - ENDE ======
' ====== Achsenskallierung - START ======
' --- X-Achse ---
With .Axes(xlCategory)
.MinimumScale = 0
.MaximumScale = 18
.MinorUnit = 0.5
.HasMinorGridlines = True
End With
' --- Y-Achse ---
With .Axes(xlValue)
.MinorUnitIsAuto = True
.MajorUnitIsAuto = True
.HasMinorGridlines = True
End With
' ====== Achsenskallierung - ENDE ======
' ' Graph 1 bis 10 erstellen ------------------- geht nicht
' For i = 1 To 5
' 'With .SeriesCollection.NewSeries.Select
' '.FullSeriesCollection(1).Name = "=M" & i
' .FullSeriesCollection(1).XValues = Sheets(7).Range(Sheets(7).Cells(5, _
i), Sheets(7).Cells(endzeile, i))
' .FullSeriesCollection(1).Values = Sheets(9).Range(Sheets(9).Cells(5, i) _
, Sheets(9).Cells(endzeile, i))
' 'End With
' Next
' ' Graph 1 bis 10 erstellen ------------------- geht nicht
' For i = 1 To 10
' .SeriesCollection.NewSeries
' .FullSeriesCollection(i).Name = "= M" & i
' .FullSeriesCollection(i).XValues = Sheets(7).Range(Sheets(7).Cells(5, i), _
Sheets(7).Cells(endzeile, i))
' .FullSeriesCollection(i).Values = Sheets(9).Range(Sheets(9).Cells(5, i), _
Sheets(9).Cells(endzeile, i))
' Next
' ####### Spezifische Graphen für Min, Mittel und Max - START #######
' Min und Max sollen in rot dargestellt sein und bilden die Hüllkurve
' Mittel wird in blau dargestellt
' ====== Graph für Min (in rot) - START ======
Set sc1 = .SeriesCollection
Set ser1 = sc1.NewSeries
With ser1
' Graph 1 erstellen (funktionierte)
.Name = Min
.XValues = Sheets(7).Range(Sheets(7).Cells(5, Spaltenzaehler - 2), _
Sheets(7).Cells(endzeile, Spaltenzaehler - 2))
.Values = Sheets(9).Range(Sheets(9).Cells(5, Spaltenzaehler - 2), _
Sheets(9).Cells(endzeile, Spaltenzaehler - 2))
With .Format.Line
.Visible = msoTrue
.ForeColor.RGB = RGB(250, 0, 0)
.Weight = 1.5
.Transparency = 0
End With
End With
' ====== Graph für Min (in rot) - ENDE ======
' ====== Graph für Mittel (in blau) - START ======
Set sc2 = .SeriesCollection
Set ser2 = sc1.NewSeries
With ser2
' Graph 1 erstellen (funktionierte)
.Name = Mittel
.XValues = Sheets(7).Range(Sheets(7).Cells(5, Spaltenzaehler - 1), _
Sheets(7).Cells(endzeile, Spaltenzaehler - 1))
.Values = Sheets(9).Range(Sheets(9).Cells(5, Spaltenzaehler - 1), _
Sheets(9).Cells(endzeile, Spaltenzaehler - 1))
With .Format.Line
.Visible = msoTrue
.ForeColor.RGB = RGB(0, 255, 255)
.Weight = 1.5
.Transparency = 0
End With
End With
' ====== Graph für Mittel (in blau) - ENDE ======
' ====== Graph für Max (in rot) - START ======
Set sc3 = .SeriesCollection
Set ser3 = sc1.NewSeries
With ser3
' Graph 1 erstellen (funktionierte)
.Name = Max
.XValues = Sheets(7).Range(Sheets(7).Cells(5, Spaltenzaehler), Sheets(7) _
.Cells(endzeile, Spaltenzaehler))
.Values = Sheets(9).Range(Sheets(9).Cells(5, Spaltenzaehler), Sheets(9). _
Cells(endzeile, Spaltenzaehler))
With .Format.Line
.Visible = msoTrue
.ForeColor.RGB = RGB(255, 69, 0)
.Weight = 1.5
.Transparency = 0
End With
End With
' ====== Graph für Max (in rot) - ENDE ======
' ####### Spezifische Graphen für Min, Mittel und Max - START #######
End With
End With
Unload UserForm1
Application.ScreenUpdating = True
MsgBox "Datenimport und -aufbereitung fertig!"
End Sub
Ich habe ein Macro aufgezeichnet und Graphen hinzugefügt.
Sheets("Tabelle10").Select
ActiveSheet.Shapes.AddChart2(240, xlXYScatterLinesNoMarkers).Select
Application.CutCopyMode = False
Application.CutCopyMode = False
ActiveChart.SeriesCollection.NewSeries
ActiveChart.FullSeriesCollection(1).Name = "=""M1"""
ActiveChart.FullSeriesCollection(1).XValues = "=Tabelle7!$A$5:$A$14000"
ActiveChart.FullSeriesCollection(1).Values = "=Tabelle9!$A$5:$A$14000"
ActiveChart.SeriesCollection.NewSeries
ActiveChart.FullSeriesCollection(2).Name = "=""M2"""
ActiveChart.FullSeriesCollection(2).XValues = "=Tabelle7!$B$5:$B$14000"
ActiveChart.FullSeriesCollection(2).Values = "=Tabelle9!$B$5:$B$14000"
ActiveChart.SeriesCollection.NewSeries
ActiveChart.FullSeriesCollection(3).Name = "=""M3"""
ActiveChart.FullSeriesCollection(3).XValues = "=Tabelle7!$C$5:$C$18"
ActiveChart.FullSeriesCollection(3).Values = "=Tabelle9!$C$5:$C$11"
In dem Marco zählt der die "FullSeriesCollection" einfach mit jeden neuen Graph um eins hoch. Dann müsste man doch auch ne Schleife bauen können in die Zahl (hier 1,2,3), die Zählvariable ist.
Macht er leider nicht. Weiß hier zufällig jemand weiter?