Datenreihe Erstellung und BESCHRIFTUNG
14.07.2006 15:03:46
Thomas
Mit der unten aufgefuehrten Makro moechte ich ein anderes xls file oeffnen (Auswertname) und in alle diagramme eine weitere Datenreihe hinzufuegen, die in
"=Protokoll!R13C27:R113C27"
"=Protokoll!R13C28:R113C28"
stehen.
die Quelldaten haben die Form
C27 ; C28 ; C29 (spalten):
Zeit in s ; Wert ; beschriftung
0 ; 0 ; Test 1
0 ; 5000 ;
0 ; ;
10 ; 0 ; Test 2
10 ; 5000
10 ; ;
Diese Datenreihe ergibt dann eine senkrechte linie zum zeitpunkt im diagramm !
danach soll diese datenreihe beschriftet werden und zwar mit:
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.ReadingOrder = xlContext
.Position = xlLabelPositionCenter
.Orientation = xlUpward
!!!!! .Top = 1 !!!!! GANZ WICHTIG
End With
Der Text der Beschriftung steht in (C29)
pkt.DataLabel.Text = Sheets("Protokoll").Cells(13 + v, 29).Value
v=v+3
-----------------
Leider funktioniert das nicht in allen diagrammen. Bei manchen passt es, bei manchen sind zwar die labels vorhanden, aber der text ist nicht sichtbar
kann mir jemand weiterhelfen, oder kennt eine bessere moeglichkeit?
hier der code:
--------------------------------------------
Sub Lastlinie()
On Error Resume Next
Dim Datenreihe As Series
Dim Punkte As Points
Dim Punkt As Point
Dim i As Integer
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Auswertname = Cells(5, 47).Value
AuswertPath = Cells(7, 8)
Auswertung = Auswertname
Workbooks.Open Filename:= _
Auswertname
For Each objS In Sheets
If Not objS.Type = -4167 Then
objS.Select
a = ActiveChart.Axes(xlValue).MinimumScale
b = ActiveChart.Axes(xlValue).MaximumScale
C = ActiveChart.Axes(xlValue).MinorUnit
d = ActiveChart.Axes(xlValue).MajorUnit
ActiveChart.SeriesCollection.NewSeries
z = ActiveChart.SeriesCollection.Count
ActiveChart.SeriesCollection(z).XValues = "=Protokoll!R13C27:R113C27"
ActiveChart.SeriesCollection(z).Values = "=Protokoll!R13C28:R113C28"
ActiveChart.SeriesCollection(z).Name = "Lastwechsel"
ActiveChart.SeriesCollection(z).Select
With Selection.Border
.ColorIndex = 1
.Weight = xlThin
.LineStyle = xlDot
End With
With Selection
.MarkerBackgroundColorIndex = xlNone
.MarkerForegroundColorIndex = xlAutomatic
.MarkerStyle = xlNone
.Smooth = True
.MarkerSize = 5
.Shadow = False
End With
With ActiveChart.Axes(xlValue)
.MinimumScale = a
.MaximumScale = b
.MinorUnit = C
.MajorUnit = d
.Crosses = xlAutomatic
.ReversePlotOrder = False
.ScaleType = xlLinear
.DisplayUnit = xlNone
End With
End If
Next
For Each objS In Sheets
If Not objS.Type = -4167 Then
objS.Select
ActiveSheet.Select
ActiveChart.Select
DiagSheet = ActiveSheet.Name
z = ActiveChart.SeriesCollection.Count
ActiveChart.SeriesCollection(z).Select
Set Datr = _
ActiveChart.SeriesCollection(z)
Datr.HasDataLabels = True
Set pkte = Datr.Points
v = 0
For Each pkt In pkte
pkt.DataLabel.Text = Sheets("Protokoll").Cells(13 + v, 29).Value
pkt.DataLabel.Text.Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.ReadingOrder = xlContext
.Position = xlLabelPositionCenter
.Orientation = xlUpward
.Top = 1
End With
v = v + 3
Next pkt
End If
Next
Application.StatusBar = False
Application.ScreenUpdating = True
Application.DisplayAlerts = True
ActiveWorkbook.Save
ActiveWindow.Close
Sheets("Übersicht").Cells(22, 10) = "Lastlinien"
Sheets("Übersicht").Cells(22, 12) = "ERSTELLT"
Sheets("Übersicht").Cells(22, 12).Select
Selection.Interior.ColorIndex = 4
Selection.Font.Bold = True
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
End Sub
---------------------------
Schon mal vielen dank im voraus.
gruss Thomas