Diagramm mit Makro erstellen

Sub DiagrammErstellen() Dim Dia As ChartObject Dim m_abgas As Integer Dim m_abgas_Min As Integer Dim m_abgas_Max As Integer With Sheets("tbl_Zieltabelle") On Error Resume Next .ChartObjects.Delete m_abgas_Min = Application.WorksheetFunction.Min(Range("B4:B" & m_abgas)) m_abgas_May = Application.WorksheetFunction.Max(Range("B4:B" & m_abgas)) Set Dia = .ChartsObjects.Add(150, 10, 500, 300) Dia.Name = "Abgasprofil" m_abgas = .Range("B4").End(xlDown).Row .Range("B4:B" & m_abgas).Copy .ChartObjects("Abgasprofil").Activate ActiveChart.SeriesCollection.Paste Rowcol:=xlColumns, SerieLabels:=False, CategoryLabels:=False, _ _ Replace:=True, NewSeries:=False Application.CutCopyMode = False ActiveChart.Location xlLocationAsObject With ActiveChart .ChartType = xlXYScatterSmooth .HasLegend = False .HasTitle = False .ChartTitle = True .ChartTitle.Text = Dia.Name End With With ActiveChart.Axes(xlValue) .MinimumScale = m_abgas_Min .MaximumScale = m_abgas_Max .MajourUnit = 500 End With End With End Sub

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Option Explicit Sub DiagrammErstellen() Dim m_abgas As Integer Dim m_abgas_Min As Integer Dim m_abgas_Max As Integer With Sheets("tbl_Zieltabelle") If .ChartObjects.Count > 0 Then .ChartObjects.Delete m_abgas = .Range("B4").End(xlDown).Row m_abgas_Min = Application.WorksheetFunction.Min(Range("B4:B" & m_abgas)) m_abgas_Max = Application.WorksheetFunction.Max(Range("B4:B" & m_abgas)) With .ChartObjects.Add(150, 10, 500, 300) .Name = "Abgasprofil" With .Chart .SetSourceData Source:=Sheets("tbl_Zieltabelle").UsedRange.Offset(2, 2) .SetSourceData Source:=Sheets("tbl_Zieltabelle").Range("B4:B" & m_abgas) .ChartType = xlXYScatterSmooth .HasLegend = False .HasTitle = True .ChartTitle.Text = .Parent.Name With .Axes(xlValue) .MinimumScale = m_abgas_Min .MaximumScale = m_abgas_Max .MajourUnit = 500 End With End With End With End With End Sub

Hi Claude,
befindet sich der Cursor beim Erstellen eines Diagramms in einem Zellbereich, den Excel als Wertebereich interpretieren kann, dann wird das Diagramm bereits mit 1 oder mehreren Datenreihen erstellt, je nachdem wie viele Zeilen/Spalten mit Werten gefüllt sind (Automatismus von Excel). Da du aber nur 1 Datenreihe benötigst, müsste man erst prüfen, wie viele Datenreihen das Diagramm enthält und falls mehr als eine, dann diese restlichen löschen. Einfacher ist es, dem Diagramm nach dem Erstellen nur 1 Zelle als Datenbereich zuzuweisen, denn dann wird das Diagramm auch nur mit 1 Datenreihe erstellt und man erspart sich das eventuell notwendige Löschen. Der Code an dieser Stelle ist eigentlich nicht korrekt (hatte ihn aus einem umfangreicheren "zusammengestrichen") - das sollte auf jeden Fall zum richtigen Ergebnis führen:

Sheets("tbl_Zieltabelle").Range("A1")

Was meinst du mit: "dass wenn ich in eine Zelle klicke, die Tabellen verschwinden."?

Hallo Beverly,
danke für deine Antwort!
Zu deinen Fragen:
- du erstellst ein Punkt(XY)-Diagramm. Normalerweise benötigt dieser Diagrammtyp (wie der Name schon ausdrückt) für jede Datenreihe X-Werte und Y-Werte. Fehlen die X-Werte bei der Wertezuweisung, werden automatisch die Zahlen von 1 aufwärts angenommen. Mit deinem Code weist du dem Diagramm nur Y-Werte zu, soll das tatsächlich so sein? Oder stehen deine X-Werte irgendwo in einer Spalte? Wenn ja wo?
Bei den Werten, die ich in meinen Spalten stehen habe, handelt es sich tatsachlich um nur Y-Werte. Über die X-Achse möchte ich so zu sagen ihre "Häufigkeit" ersehen können. Daher ist es super, dass Excel, den Werten automatisch die Zahlen von 1 aufwärts zuweist. :))
- die Daten in Spalte D - soll das eine zweite Datenreihe sein? Soll sie auf die Sekundärachse gezeichnet werden, da sie eine andere Größenordnung als die Werte in Spalte B aufweist?
Ja,das wäre vielleicht eine Lösung für mein Problem!
Das ist nämlich aktuell folgendes:
Ich habe versucht in mein Diagramm mir, um längen kleinere, Y-Werte aus der D-Spalte anzeigen zu lassen.
Wenn ich das Makro separat ausführen lasse(also den Play-Button im Editor), dann habe ich zwar eine Skalierung der Y-Achse von 8000 bis ca 200 für die Werte in beiden Spalten, aber dafür eine angepasste an den maximalen Wert der da ist in Spalte B.
Wenn ich das Makro über ein anderes Makro mittels "Call" aufrufe, dann verzerrt es die Skalierung, sodass nur noch die Y-Werte bis 3000 gehen-mir also nur ein kleiner Ausschnitt gezeigt wird. =-O
Woran könnte das liegen?
Hier ist mein Code, den ich auf Grundlage deines Hinweises gestern gebastelt habe:

Option Explicit
Sub Diagramm_erstellen()
Dim m_abgas As Integer
Dim m_abgas_Min As Integer
Dim m_abgas_Max As Integer
Dim T_abgas As Integer
Dim T_abgas_Min As Integer
Dim T_abgas_Max As Integer
With Sheets("tbl_Zieltabelle")
If .ChartObjects.Count > 0 Then .ChartObjects.Delete
T_abgas = .Range("D4").End(xlDown).Row
T_abgas_Min = Application.WorksheetFunction.Min(Range("D4:D" & T_abgas))
T_abgas_Max = Application.WorksheetFunction.Max(Range("D4:D" & T_abgas))
m_abgas = .Range("B4").End(xlDown).Row
m_abgas_Min = Application.WorksheetFunction.Min(Range("B4:B" & m_abgas))
m_abgas_Max = Application.WorksheetFunction.Max(Range("B4:B" & m_abgas))
With .ChartObjects.Add(350, 25, 550, 400)
.Name = "Abgasprofil"
With .Chart
.SeriesCollection.NewSeries
.SeriesCollection(1).Values = Sheets("tbl_Zieltabelle").Range("B4:B" & m_abgas)
.ChartType = xlXYScatterSmoothNoMarkers
.HasLegend = True
.SeriesCollection(1).Name = "Abgasmassenstrom"
.SeriesCollection.NewSeries
.SeriesCollection(2).Values = Sheets("tbl_Zieltabelle").Range("D4:D" & T_abgas)
.ChartType = xlXYScatterSmoothNoMarkers
.HasLegend = True
.SeriesCollection(2).Name = "Abgastemperatur"
.HasTitle = True
With .Axes(xlValue)
.MinimumScale = m_abgas_Min
.MaximumScale = m_abgas_Max
.MajorUnit = 250
End With
With .SeriesCollection(1)
.Border.Color = RGB(0, 200, 100)
.Border.Weight = xlThick
.Border.LineStyle = xlContinuous
End With
With .SeriesCollection(2)
.Border.Color = RGB(100, 200, 100)
.Border.Weight = xlThick
.Border.LineStyle = xlContinuous
End With
End With
End With
End With
End Sub

Ganz ganz großes Danke!!
Wirklich!
Liebe Grüße
Claudia
ps. das Problem, dass meine Tabellen verschunden sind...ich weiß nicht was ich gemacht habe, aber es ist nicht mehr existent. :)

Private Sub Auswertung_anzeigen_Click() Application.ScreenUpdating = False Call Abgasprofil_kop 'Kopiert Werte aus Blatt tbl_Profil in tbl_Zieltabelle, Spalten B und D Call Diagramm_erstellen 'erstellt Diagramm im Blatt tbl_Zieltabelle Application.ScreenUpdating = False Worksheets("tbl_Zieltabelle").Select End Sub

Sub Diagramm_erstellen() Dim m_abgas As Integer Dim m_abgas_Min As Integer Dim m_abgas_Max As Integer Dim T_abgas As Integer Dim T_abgas_Min As Integer Dim T_abgas_Max As Integer With Sheets("tbl_Zieltabelle") If .ChartObjects.Count > 0 Then .ChartObjects.Delete T_abgas = .Range("D4").End(xlDown).Row T_abgas_Min = Application.WorksheetFunction.Min(Range("D4:D" & T_abgas)) T_abgas_Max = Application.WorksheetFunction.Max(Range("D4:D" & T_abgas)) m_abgas = .Range("B4").End(xlDown).Row m_abgas_Min = Application.WorksheetFunction.Min(Range("B4:B" & m_abgas)) m_abgas_Max = Application.WorksheetFunction.Max(Range("B4:B" & m_abgas)) With .ChartObjects.Add(350, 25, 550, 400) .Name = "Abgasprofil" With .Chart .ChartType = xlXYScatterSmoothNoMarkers .HasLegend = True .HasTitle = True With .SeriesCollection.NewSeries .Values = Sheets("tbl_Zieltabelle").Range("B4:B" & m_abgas) .XValues = Sheets("tbl_Zieltabelle").Range("A4:A" & m_abgas) .Name = "Abgasmassenstrom" .Border.Color = RGB(0, 200, 100) .Border.Weight = xlThick .Border.LineStyle = xlContinuous End With With .SeriesCollection.NewSeries .Values = Sheets("tbl_Zieltabelle").Range("D4:D" & T_abgas) .XValues = Sheets("tbl_Zieltabelle").Range("A4:A" & m_abgas) .Name = "Abgastemperatur" .Border.Color = RGB(100, 200, 100) .Border.Weight = xlThick .Border.LineStyle = xlContinuous ' der Sekundärachse zuweisen .AxisGroup = 2 End With ' Primärachse skalieren With .Axes(xlValue, xlPrimary) .MinimumScale = m_abgas_Min .MaximumScale = m_abgas_Max .MajorUnit = 250 End With ' Sekundärachse skalieren With .Axes(xlValue, xlSecondary) .MinimumScale = T_abgas_Min .MaximumScale = T_abgas_Max ' .MajorUnit = 5 '

Beliebteste Forumthreads (12 Monate)

13
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

306 Forumthreads zu ähnlichen Themen

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Diagramm mit Makro erstellen

13 Beiträge zum Forumthread Beiträge zu diesem Forumthread

306 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

13
Beiträge zum Forumthread

Beiträge zu diesem Forumthread