Anzeige
Archiv - Navigation
780to784
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
780to784
780to784
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

Datenreihe Erstellung und BESCHRIFTUNG

Datenreihe Erstellung und BESCHRIFTUNG
14.07.2006 15:03:46
Thomas
Hallo VBAler
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

1
Beitrag zum Forumthread
Beitrag zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Datenreihe Erstellung und BESCHRIFTUNG
14.07.2006 16:04:58
Thomas
ups soll natuerlich so heissen:
Dim Datr As Series
Dim Pkte As Points
Dim Pkt As Point
Dim i As Integer
funktioniert aber trotzdem nicht.
Kann mir jemand helfen, bitte !
gruss thomas
Anzeige

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige