AW: Name eine Serie in Chart ändern
15.12.2003 10:00:59
Dominik
wie mache ich das? wie lade ich die File komplett hoch?
Reichen Dir auszüge? Kann leider nicht alles reinstellen!
Hier alle Makros die mit diesem was zu tun haben!
Private Sub MessOkBut_Click()
Dim i As Variant, exIst As Variant, dif As Variant, k As Variant, m As Variant
Dim zeile As Variant, wert As String, wert2 As String, NameMess As Variant, BlaNameBox As String
If MessBox <> "" Then
Mess = CDbl(MessBox)
End If
i = 7
wert = Sheets("Daten").Cells(9, i).Value
Do Until wert = ""
wert = Sheets("Daten").Cells(9, i).Value
i = i + 1
Loop
i = i - 2
BlaNameBox = Sheets("Daten").Cells(9, i).Value
'Überprüfen ob Messungsnummer existiert
i = 0
Do Until i = Sheets("Daten").Cells(9, 1).Value
If Sheets("Daten").Cells(9 + i, 1).Value = Mess Then
exIst = True
End If
i = i + 1
Loop
If exIst = False Then
MsgBox ("Bitte geben sie einen richtigen Wert für die Messungsnummer an!")
Exit Sub
Else
zeile = 1
wert = Sheets(BlaNameBox).Cells(zeile, 1).Value
Do Until wert = "" Or zeile > 500
wert = Sheets(BlaNameBox).Cells(zeile, 1).Value
zeile = zeile + 1
Loop
If zeile <> 1 Then
zeile = zeile - 1
End If
Call allerAnf
'Name der Messung suchen
dif = Sheets("Daten").Cells(9, 1).Value
k = 9
m = Sheets("Daten").Cells(k, 1).Value
Do Until m = Mess Or k > dif + 9
k = k + 1
m = Sheets("Daten").Cells(k, 1).Value
Loop
NameMess = Sheets("Daten").Cells(k, 2).Value
Call Vorlage(BlaNameBox, zeile, NameMess)
'Passende Zeile suchen
l = 11 + dif
wert = Sheets("Daten").Cells(l, 1).Value
wert2 = Sheets("Daten").Cells(l, 2).Value
Do Until wert = "Versuchs-Nr.:" And wert2 = MessBox Or l > 1000
l = l + 1
wert = Sheets("Daten").Cells(l, 1).Value
wert2 = Sheets("Daten").Cells(l, 2).Value
Loop
l = l + 10
j = 1
Do Until j = 7
Cells(zeile + 3, j).Formula = "=Daten!G" & l
j = j + 1
l = l + 1
Loop
'l ist jetzt auf höhe der gelb makierten Mittelwert Daten
' Chart hinzufügen
i = Sheets.Count
exIst = False
j = 1
Do Until j >= i
If Sheets(j).Name = "Diagramm " & BlaNameBox Then
exIst = True
End If
j = j + 1
Loop
If exIst = True Then
Call Reihe_Hinzu(BlaNameBox, l)
Else
Call Ubersicht(BlaNameBox, l)
End If
End If
HinzuForm.Hide
Call allerEnd
End Sub
Public Sub Vorlage(BlaNameBox As String, zeile As Variant, a As Variant)
'Dieses ganze gedöhns wurde nur aufgezeichnet mittels Makroaufzeichner, es hat die Aufgabe
' die Vorlage für das Vergleichsblatt zu bilden
Sheets(BlaNameBox).Select
Range("A" & zeile & ":F" & zeile).Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.ShrinkToFit = False
.MergeCells = False
End With
Selection.Merge
ActiveCell.FormulaR1C1 = "Probe " & a
Selection.Interior.ColorIndex = 41
Range("A" & zeile + 1 & "").Select
ActiveCell.FormulaR1C1 = "Dm nach "
With ActiveCell.Characters(Start:=1, Length:=1).Font
.Name = "Symbol"
.FontStyle = "Standard"
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
End With
With ActiveCell.Characters(Start:=2, Length:=7).Font
.Name = "System"
.FontStyle = "Standard"
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
End With
Range("A" & zeile + 1 & "").Select
ActiveCell.FormulaR1C1 = "Dm nach 2000 Umdrehungen"
With ActiveCell.Characters(Start:=1, Length:=1).Font
.Name = "Symbol"
.FontStyle = "Standard"
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
End With
With ActiveCell.Characters(Start:=2, Length:=23).Font
.Name = "Arial"
.FontStyle = "Standard"
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
End With
Range("A" & zeile + 1 & ":C" & zeile + 1).Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.ShrinkToFit = False
.MergeCells = False
End With
Selection.Merge
Range("D" & zeile + 1 & ":F" & zeile + 1).Select
ActiveCell.FormulaR1C1 = "Dm nach 2000 Umdrehungen, Fit"
With ActiveCell.Characters(Start:=1, Length:=1).Font
.Name = "Symbol"
.FontStyle = "Standard"
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
End With
With ActiveCell.Characters(Start:=2, Length:=28).Font
.Name = "Arial"
.FontStyle = "Standard"
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
End With
Range("D" & zeile + 1).Select
ActiveCell.FormulaR1C1 = "Dm nach 2000 Umdrehungen, FIT"
With ActiveCell.Characters(Start:=1, Length:=1).Font
.Name = "Symbol"
.FontStyle = "Standard"
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
End With
With ActiveCell.Characters(Start:=2, Length:=28).Font
.Name = "Arial"
.FontStyle = "Standard"
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
End With
Range("A" & zeile + 2).Select
ActiveCell.FormulaR1C1 = "Dm in mm3"
With ActiveCell.Characters(Start:=1, Length:=1).Font
.Name = "Symbol"
.FontStyle = "Standard"
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
End With
With ActiveCell.Characters(Start:=2, Length:=8).Font
.Name = "Arial"
.FontStyle = "Standard"
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
End With
Range("B" & zeile + 2).Select
ActiveCell.FormulaR1C1 = "St.Abw."
Range("C" & zeile + 2).Select
ActiveCell.FormulaR1C1 = "in %"
Range("A" & zeile + 2 & ":C" & zeile + 2 & "").Select
Range("C" & zeile + 2).Activate
Selection.Copy
Range("D" & zeile + 2).Select
ActiveSheet.Paste
Range("A" & zeile + 1 & ":C" & zeile + 1).Select
Selection.Interior.ColorIndex = 43
Range("D" & zeile + 1 & ":F" & zeile + 1 & "").Select
Selection.Interior.ColorIndex = 44
Range("A" & zeile + 4) = "x"
Range("A" & zeile + 4).Select
With ActiveCell.Characters(Start:=2, Length:=8).Font
.Name = "Arial"
.FontStyle = "Standard"
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = 2
End With
Public Sub allerAnf()
'Blattschutz aufheben
'ActiveSheet.Unprotect
'Monitor aus
Application.ScreenUpdating = False
End Sub
Public Sub allerEnd()
'Blatt schützen
'ActiveSheet.Protect
'Monitor ein
Application.ScreenUpdating = True
End Sub
End Sub
Public Sub Ubersicht(Name As String, l As Variant)
Dim b As Variant, c As Variant, ActiveChart As Object, a As String, d As String, e As String, f As String
Dim serie1 As Variant, serie2 As Variant
'erst herausfinden wo Daten stecken
c = Sheets("Daten").Cells(5, 8).Value
b = Sheets("Daten").Cells(9, 2).Value
serie1 = Sheets("Daten").Cells(l - 16, 4).Value
serie2 = Sheets("Daten").Cells(l + 1, 10).Value
Set ActiveChart = Application.Charts.Add
ActiveChart.ChartType = xlXYScatter
ActiveChart.SetSourceData Source:=Sheets("Daten").Range( _
"K" & l - 11 & ":O" & l - 11 & ",K" & l & ":O" & l & ",K" & l + 2 & ":O" & l + 2), PlotBy:=xlRows
ActiveChart.Location Where:=xlLocationAsNewSheet, Name:="Diagramm " & Name
With ActiveChart
.HasTitle = True
.ChartTitle.Characters.Text = Name & " in " & b
.Axes(xlCategory, xlPrimary).HasTitle = True
.Axes(xlCategory, xlPrimary).AxisTitle.Characters.Text = "Zeit [t]"
.Axes(xlValue, xlPrimary).HasTitle = True
.Axes(xlValue, xlPrimary).AxisTitle.Characters.Text = c
.SeriesCollection(1).Name = "serie1"
End With
a = ActiveChart.SeriesCollection.Count
'.SeriesCollection(2).Name = "serie2"
'End With
'Reihe 1 formatieren
ActiveChart.SeriesCollection(1).Select
With Selection.Border
.ColorIndex = 1
.Weight = xlHairline
.LineStyle = xlNone
End With
With Selection
.MarkerBackgroundColorIndex = 1
.MarkerForegroundColorIndex = 1
.MarkerStyle = xlDiamond
.Smooth = False
.MarkerSize = 5
.Shadow = False
End With
'Reihe 2 formatieren
'ActiveChart.SeriesCollection(2).Name = Name & "Regression"
ActiveChart.SeriesCollection(2).Select
With Selection.Border
.ColorIndex = 2
.Weight = xlThin
.LineStyle = xlDashDot
End With
With Selection
.MarkerBackgroundColorIndex = 2
.MarkerForegroundColorIndex = 2
.MarkerStyle = xlDot
.Smooth = False
.MarkerSize = 5
.Shadow = False
End With
'legende formatieren
ActiveChart.Legend.Select
Selection.Height = 200
Selection.Left = 615
Selection.Top = 10
ActiveChart.PlotArea.Select
ActiveChart.Axes(xlValue).MajorGridlines.Select
ActiveChart.PlotArea.Select
Selection.Interior.ColorIndex = xlNone
'Extra Rechteck rechts unten wird erstellt
a = Sheets("Daten").Cells(1, 4).Value
b = Sheets("Daten").Cells(1, 2).Value
c = Sheets("Daten").Cells(1, 6).Value
d = Sheets("Daten").Cells(1, 6).Value
e = Sheets("Daten").Cells(3, 6).Value
f = ActiveSheet.Name
g = Workbook.Name
ActiveChart.ChartArea.Select
ActiveChart.Shapes.AddShape(msoShapeRectangle, 617.65, 225.98, 95.95, 212.26). _
Select
Selection.ShapeRange.IncrementLeft 0#
Selection.ShapeRange.IncrementTop -5.65
ActiveChart.ChartArea.Select
ActiveChart.Shapes("Rectangle 1").Select
Selection.Characters.Text = _
"Projekt:" & Chr(10) & a & Chr(10) & "Bearbeiter:" & Chr(10) & b & Chr(10) _
& "Bearbeitungsdatum:" & Chr(10) & c & Chr(10) & "Datei-Version:" & Chr(10) _
& d & Chr(10) & "Dateiname" & Chr(10) & g & Chr(10) & "Name des Vergleichblattes" & _
Chr(10) & f & Chr(10) & "Sonstiges:" & Chr(10) & e
Selection.AutoScaleFont = False
With Selection.Characters(Start:=1, Length:=78).Font
.Name = "Arial"
.FontStyle = "Standard"
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
End With
ActiveChart.HasLegend = True
ActiveChart.Legend.Select
Selection.Position = xlRight
End Sub