Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
1156to1160
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
Inhaltsverzeichnis

Variables Diagramm per Makro mit Abfrage

Variables Diagramm per Makro mit Abfrage
bspa
Hallo,
mein Problem ist folgendes: Ich habe eine Exceldatei mit mehreren Tabellenblättern. Alle Tabellenblätter sind zu 100% identisch aufgebaut.
Ich möchte von bis zu maximal 6 Datenreihen aus verschiedenen Tabellenblättern ein Diagramm zeichnen lassen.
Feste Eigenschaften vom Diagramm:
- Punktdiagramm (X,Y), mit interpolierten Linien
- X-Werte sind immer gleich
- Achsenbeschriftung: Rubrikenachse (X): Zeit (h)
- Achsenbeschriftung: Größenachse (Y): Verformung (mm)
- Skalierung der Größenachse (X): Maximum 100
Nun habe ich die Vorstellung von einem Makro, welches wenn ich es aufrufe, mich fragt wieviele Graphen gezeichnet werden sollen (Max. 6), dann den Diagrammtitel abfragt, anschließend den Namen der 1. Datenreihe und letztendlich die Y-Werte der 1.Datenreihe abfragt, usw. mit der 2. Datenreihe ...
Abfragen während des Makros:
- Anzahl der Graphen, die gezeichnet werden sollen: Minimum 1, Maximum 6
- Diagrammtitel: über Inputbox oder über markieren einer Zelle
- Name der 1. Datenreihe: auch über Inputbox oder markieren einer Zelle
- Y-Werte der 1.Datenreihe: über markieren der entsprechenden Zellen im entsprechenden Tabellenblatt
- Name der 2. Datenreihe
- Y-Werte der 2.Datenreihe
usw. entsprechend der eingegeben Anzahl der Graphen
Also ich habe auch ein Makro aufgenommen, aber ich tu mir sehr schwer diese Makro entsprechend anzupassen. Dafür sind meine Kenntnisse leider noch zu low.
Jede Art von Unterstützung und Ratschläge sind sehr willkommen. Jetzt kommt noch mein Makro welches ich aufgenommen habe.
Grüße, bspa
Sub test01()
Charts.Add
ActiveChart.ChartType = xlXYScatterSmooth
ActiveChart.SetSourceData Source:=Sheets("T1=1050").Range("I23")
ActiveChart.SeriesCollection.NewSeries
ActiveChart.SeriesCollection.NewSeries
ActiveChart.SeriesCollection(1).XValues = "='T1=1050'!R2C18:R2C24"
ActiveChart.SeriesCollection(1).Values = "='T1=1050'!R8C18:R8C24"
ActiveChart.SeriesCollection(1).Name = "='T1=1050'!R3C2:R18C2"
ActiveChart.SeriesCollection(2).XValues = "='T1=1050'!R2C18:R2C24"
ActiveChart.SeriesCollection(2).Values = "='T3=950'!R8C18:R8C24"
ActiveChart.SeriesCollection(2).Name = "='T3=950'!R3C2:R18C2"
ActiveChart.Location Where:=xlLocationAsObject, Name:="T1=1050"
With ActiveChart
.HasTitle = True
.ChartTitle.Characters.Text = "Diagrammtitel abfragen"
.Axes(xlCategory, xlPrimary).HasTitle = True
.Axes(xlCategory, xlPrimary).AxisTitle.Characters.Text = "Zeit (h)"
.Axes(xlValue, xlPrimary).HasTitle = True
.Axes(xlValue, xlPrimary).AxisTitle.Characters.Text = "Verformung (mm)"
End With
ActiveChart.HasLegend = True
ActiveChart.Legend.Select
Selection.Position = xlBottom
ActiveChart.Axes(xlCategory).Select
With ActiveChart.Axes(xlCategory)
.MinimumScaleIsAuto = True
.MaximumScale = 100
.MinorUnitIsAuto = True
.MajorUnitIsAuto = True
.Crosses = xlAutomatic
.ReversePlotOrder = False
.ScaleType = xlLinear
.DisplayUnit = xlNone
End With
With Selection.TickLabels
.ReadingOrder = xlContext
.Orientation = xlHorizontal
End With
End Sub

3
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Benutzer
Anzeige
AW: Variables Diagramm per Makro mit Abfrage
15.05.2010 07:57:29
welga
Hallo,
alsoich würde Namen für die jeweiligen Datenbereiche vergeben (z.B. Data1, Data2,...).
Dann mit folgendem Makro das Diagramm ertsellen:
Sub Diagramm_erstellen()
Dim anzahl As Long, i As Long
Dim titel As String
For i = ThisWorkbook.Sheets.Count To 1 Step -1
If Left(Sheets(i).Name, 8) Like "Diagramm" Then Sheets(i).Delete
Next i
Charts.Add
ActiveSheet.Name = "Diagramm"
Sheets("Diagramm").Move After:=Sheets(7)
nochmal1:
anzahl = InputBox("Bitte geben Sie die Anzahl der Graphen ein:", "Dateneingabe:")
If anzahl  6 Then
MsgBox ("Anzahl der graphen muss zwischen 1 und 6 liegen!")
GoTo nochmal1
End If
nochmal2:
titel = InputBox("Bitte geben Sie einen Diagrammtitel ein:", "Texteingabe:")
If titel = "" Then
MsgBox ("Bitte einen Diagrammtitel eingeben!")
GoTo nochmal2
End If
ActiveChart.ChartType = xlXYScatterSmooth
For i = 1 To anzahl
ActiveChart.SeriesCollection.NewSeries
ActiveChart.SeriesCollection(i).XValues = "=test.xls!X_Achse"
ActiveChart.SeriesCollection(i).Values = "=test.xls!Data" & i
ActiveChart.SeriesCollection(i).Name = "Data" & i
Next i
ActiveChart.Location Where:=xlLocationAsNewSheet
With ActiveChart
.HasTitle = True
.ChartTitle.Characters.Text = titel
.Axes(xlCategory, xlPrimary).HasTitle = True
.Axes(xlCategory, xlPrimary).AxisTitle.Characters.Text = "Zeit (h)"
.Axes(xlValue, xlPrimary).HasTitle = True
.Axes(xlValue, xlPrimary).AxisTitle.Characters.Text = "Veformung (mm)"
End With
ActiveChart.HasLegend = True
ActiveChart.Legend.Select
Selection.Position = xlBottom
ActiveChart.ApplyDataLabels Type:=xlDataLabelsShowNone, LegendKey:=False
With ActiveChart.Axes(xlCategory)
.MinimumScaleIsAuto = True
.MaximumScale = 100
.MinorUnit = 5
.MajorUnit = 10
.Crosses = xlAutomatic
.ReversePlotOrder = False
.ScaleType = xlLinear
.DisplayUnit = xlNone
End With
End Sub

Wenn ich deine Bsp-Datei hätte, könnte ich aber näheres sagen.
Gruß
welga
Anzeige
AW: Variables Diagramm per Makro mit Abfrage
15.05.2010 09:03:47
fcs
Hallo Heinz,
ich hab das hier für dich erstellte Makro https://www.herber.de/forum/messages/1156890.html
entsprechend angepasst/erweitert.
Gruß
Franz
'Erstellt unter Excel 2007
Sub Test()
Dim wks As Worksheet, iSerie As Long, Bereich As Variant
Dim oChart As Chart, spName&, spData1&, spData2&, ZeileX&, ZeileY&, ZeileName&
Dim strRngName As String
On Error GoTo Fehler
Set wks = ActiveSheet
With ActiveCell 'wks.Range("C3") 'Einfüge-Zelle für Diagramm
'Diagramm-Objekt einfügen relativ zu Zelle mit angegebenen Abmessungen
Set oChart = wks.ChartObjects.Add(Left:=.Left, Top:=.Top, Width:=600, _
Height:=500).Chart
End With
oChart.ChartType = xlXYScatterSmooth
Anzahl_Datenreihen:
'Anzahl Datenreihen eingeben
iSerie = Application.InputBox(Prompt:="Anzahl Datenreihen ( 1 bis 6) ?", _
Title:="Diagrammerstellung - Anzahl Datenreihen", Default:=1, Type:=1)
Select Case iSerie
Case 1 To 6
For iSerie = 1 To iSerie
'Vorgabewerte setzen für Datenspalten
spData1 = 18  '1. Datenspalte
spData2 = 24  'Letzte Datenspalte
ZeileX = 2    'Zeile mit X-Werten
'Name der Datenreihe auswählen - es kann auch ein _
Zellbereich in einer Spalte oder Zeile gewählt werden. Mit dem dem _
Namen wird auch das Tabellenblatt festgelegt aus dem die Y-Werte _
der Datenreihe geholt werden.
Set Bereich = Application.InputBox( _
Prompt:="Zelle/Zellbereich für den Namen der Reihe wählen" _
& vbLf & "Falls erforderlich Blatt wechseln!", _
Title:="Diagrammerstellung - Datenreihe " & iSerie, _
Type:=8)
ZeileName = Bereich.Row
spName = Bereich.Column
'Zellbereich des Namens merken
strRngName = Bereich.Address(ReferenceStyle:=xlA1)
Set wks = Bereich.Parent
With wks
'Bereich mit den Y-Werten wählen. Als Default wird der Datenbereich _
aus der Zeile des gewählten Namens vorgegeben. Dadurch wird auch _
das entsprechende Tabellenblatt wieder angezeigt
Set Bereich = Application.InputBox( _
Prompt:="Zellen mit Y-Werten der Reihe wählen", _
Title:="Diagrammerstellung - Datenreihe " & iSerie, _
Default:="'" & .Name & "'!" & .Range(.Cells(ZeileName, spData1), _
.Cells(ZeileName, spData2)).Address(ReferenceStyle:=xlA1), _
Type:=8)
spData1 = Bereich.Column  '1. Datenspalte
spData2 = Bereich.Column + Bereich.Columns.Count - 1 'Letzte Datenspalte
ZeileY = Bereich.Row      'Zeile mit den Y-Werten der Reihe
'Datenreihe erstellen
oChart.SeriesCollection.NewSeries
oChart.SeriesCollection(iSerie).XValues = "='" & .Name & "'!" & _
.Range(.Cells(ZeileX, spData1), .Cells(ZeileX, spData2)) _
.Address(ReferenceStyle:=xlA1)
oChart.SeriesCollection(iSerie).Values = "='" & .Name & "'!" & _
.Range(.Cells(ZeileY, spData1), .Cells(ZeileY, spData2)) _
.Address(ReferenceStyle:=xlA1)
oChart.SeriesCollection(iSerie).Name = "='" & .Name & "'!" & strRngName
End With
Next
Resume01:
With oChart
'X-Achse formatieren
.Axes(xlCategory, xlPrimary).HasTitle = True
.Axes(xlCategory, xlPrimary).AxisTitle.Characters.Text = "Zeit (h)"
With .Axes(xlCategory)
.MinimumScaleIsAuto = True
.MaximumScale = 100
.MinorUnitIsAuto = True
.MajorUnitIsAuto = True
.Crosses = xlAutomatic
.ReversePlotOrder = False
.ScaleType = xlLinear
.DisplayUnit = xlNone
With .TickLabels
.ReadingOrder = xlContext
.Orientation = xlHorizontal
End With
End With
'Y-Achse formatieren
.Axes(xlValue, xlPrimary).HasTitle = True
.Axes(xlValue, xlPrimary).AxisTitle.Characters.Text = "Verformung (mm)"
'Legende anzeigen und positionieren
.HasLegend = True
.Legend.Position = xlBottom
'Diagrammtitel anzeigen und ausfüllen
.HasTitle = True
With .ChartTitle
.Text = Application.InputBox(Prompt:="Diagrammtitel eingeben/wählen", _
Title:="Diagrammerstellung - Diagrammtitel", Type:=2)
End With
End With
Case Is > 6
'Eingabe-Inputbox erneut anzeigen
GoTo Anzahl_Datenreihen
Case Else
Resume02:
'Begonnene Diagrammerstellung wird abgebrochen und Diagramm wird gelöscht
oChart.Parent.Delete
End Select
Err.Clear
Fehler:
With Err
Select Case .Number
Case 0 'Alles OK
Case 13 'Type-Fehler - Bereichsauswahl wurde abgebrochen
If iSerie = 1 Then
'Begonnene Diagrammerstellung wird abgebroch und Diagramm wird gelöscht
Resume Resume02
ElseIf iSerie > 1 Then
'Diagramm wird mit den bereits gewählten Datenreihen fertiggestellt.
Resume Resume01
End If
Case Else
MsgBox "Fehler-Nr.: " & .Number & vbLf & .Description
End Select
End With
End Sub

Anzeige
AW: Variables Diagramm per Makro mit Abfrage
16.05.2010 11:19:45
bspa
Hallo welga und fcs,
erstmal vielen Dank für euren Einsatz. Ich bin wirklich überrascht von der Hilfsbereitschaft in diesem Forum. Find ich klasse.
An welga,
leider bekomme ich bei deinem Makro eine Fehlermeldung:
"Laufzeitfehler 1004: Die XValues-Eigenschaft des Series-Objektes kann nicht festgelegt werden"
in dieser Zeile soll debuggt werden:
ActiveChart.SeriesCollection(i).XValues = "=test.xls!X_Achse"
An fcs,
dein code funzt super. Das erleichtert mir total die Auswertung meiner Messergebnisse.
Klasse find ich auch deine Bemerkungen im Programm. Das erleichtert mir den Aufbau und die Syntax etwas besser zu verstehen.
Grüße, bspa
Anzeige

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige