Live-Forum - Die aktuellen Beiträge
Datum
Titel
25.04.2024 18:41:19
vba Zeilen duplizieren ab aktiver Zeile bis letzte Zeile
25.04.2024 18:22:55
Zeilen mit bestimmtem Datum in andere Mappe übertragen
25.04.2024 18:14:45
VBA - Excell - Kopie und "Diebstahl" Schützen
25.04.2024 17:49:39
Bedingte Formatierung
Du findest keine passende Antwort auf Deine Frage?
Stelle Deine Frage in unserem Live-Forum
Anzeige
Archiv - Navigation
1476to1480
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
Vorheriger Thread
Vorheriger Thread
Rückwärts Blättern
1476to1480
1476to1480
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Nächster Thread
Nächster Thread
Vorwärts blättern
Inhaltsverzeichnis

DataLabel formatieren

DataLabel formatieren
26.02.2016 19:29:44
Jörg
Hallo,
ich habe ein Diagramm bei dem der jeweils letzte Punkt mit einem DataLabel versehen ist.
Ich würde gerne das DataLabel formatieren, d.h. es soll folgendes Format haben:
z.B. 37,14%
hier mein Versuch:
Set c = ActiveWorkbook.Charts("Muskelanteil")
With c
.ChartType = xlXYScatterLinesNoMarkers
.SetSourceData Source:=Worksheets("Daten").Range(Worksheets("Daten").Cells(3, 2), Worksheets("Daten").Cells(ez + 1, 4))
.PlotBy = xlColumns
'DataLabel des vorletzten Punktes im Diagramm löschen
.SeriesCollection(1).Points(.SeriesCollection(1).Points.Count - 1).HasDataLabel = False
'DataLabel für den letzten Punkt
With .SeriesCollection(1).Points(.SeriesCollection(1).Points.Count)
.HasDataLabel = True
.DataLabel.Text = Worksheets("Daten").Cells(ez + 1, 3).Value
.DataLabel.NumberFormat = "0.00%"
End With
End With
Für Hilfe bin ich wirklich dankbar!!

4
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: DataLabel formatieren
26.02.2016 19:54:04
Beverly
Hi Jörg,
weise zuerst der kompletten Datenreihe die Beschriftungslabel zu und lösche alle nicht benötigten:
 Dim lngPunkt As Long
'Diagramm Muskelanteil aktualisieren
Set c = ActiveWorkbook.Charts("Muskelanteil")
With c
.ChartType = xlXYScatterLinesNoMarkers
.SetSourceData Source:=Worksheets("Daten").Range(Worksheets("Daten").Cells(3, 2), _
Worksheets("Daten").Cells(ez + 1, 4))
.PlotBy = xlColumns
'DataLabel des vorletzten Punktes im Diagramm löschen
With .SeriesCollection(1)
.DataLabels.Delete
.ApplyDataLabels
For lngPunkt = 1 To .Points.Count - 1
.Points(lngPunkt).DataLabel.Delete
Next lngPunkt
End With
End With
Set c = Nothing

Anzeige
AW: DataLabel formatieren
27.02.2016 22:54:06
Jörg
Hallo Karin,
danke für die Hilfe!! Leider komme ich noch nicht ganz klar - ich erhalte eine mir unbekannte Fehlermeldung.
Deswegen werde ich einen großen Teil meines Makros hier abdrucken und nicht nur einen Ausschnitt.
Der unten stehende Code bezieht sich auf 1 Diagramm - wenn ich damit klarkomme, dann komme ich auch bei den anderen klar.
Sub bilanz()
Dim z As Integer, ez As Integer
Dim lngPunkt As Long
Dim d1 As Date, d2 As Date, d3 As Date
Dim Mw As Double, Mmin As Double, Fw As Double, Fmax As Double
Dim Ww As Double, Wmin As Double, Kw As Double, IG As Double, Gw As Double
Dim MinWertDiag As Double, MaxWertDiag As Double, a As Double, b As Double
Dim g As Double, d As Double
Dim r As Range
Dim c As Chart
Dim ca As Axis
'Alter berechnen
d1 = "14.12.1980"
d2 = Date
alter = Application.WorksheetFunction.RoundDown((d2 - d1) / 365, 0)
'Grenzen definieren
'Fettanteil
If alter > 30 And alter If alter > 40 And alter If alter > 50 And alter If alter > 60 And alter If alter > 70 And alter 'Wasseranteil
If alter > 10 And alter 'Muskelanteil
If alter > 30 And alter If alter > 40 And alter If alter > 50 And alter If alter > 60 And alter If alter > 70 And alter 'Messwerte einlesen
UserForm.Show
Mw = UserForm.TextBox1 / 100
Fw = UserForm.TextBox2 / 100
Ww = UserForm.TextBox3 / 100
Kw = UserForm.TextBox4
IG = 69.3
Gw = UserForm.TextBox6
d3 = UserForm.TextBox7
'Werte aufs Blatt schreiben
'Endzeile ermitteln (letzte gefüllte Zeile)
ez = 0
z = 4
Do Until ActiveSheet.Cells(z, 2) = ""
z = z + 1
Loop
ez = z - 1
'Messwerte eintragen
If ez = 3 Then
ActiveSheet.Cells(ez + 1, 1) = d3
ActiveSheet.Cells(ez + 1, 2) = 1
ActiveSheet.Cells(ez + 1, 5) = 1
ActiveSheet.Cells(ez + 1, 8) = 1
ActiveSheet.Cells(ez + 1, 11) = 1
ActiveSheet.Cells(ez + 1, 13) = 1
ActiveSheet.Cells(ez + 1, 3) = Mw
ActiveSheet.Cells(ez + 1, 4) = Mmin
ActiveSheet.Cells(ez + 1, 6) = Fw
ActiveSheet.Cells(ez + 1, 7) = Fmax
ActiveSheet.Cells(ez + 1, 9) = Ww
ActiveSheet.Cells(ez + 1, 10) = Wmin
ActiveSheet.Cells(ez + 1, 12) = Kw
ActiveSheet.Cells(ez + 1, 14) = IG
ActiveSheet.Cells(ez + 1, 15) = Gw
Else
ActiveSheet.Cells(ez + 1, 1) = d3
ActiveSheet.Cells(ez + 1, 2) = ActiveSheet.Cells(ez, 2) + 1
ActiveSheet.Cells(ez + 1, 5) = ActiveSheet.Cells(ez, 5) + 1
ActiveSheet.Cells(ez + 1, 8) = ActiveSheet.Cells(ez, 8) + 1
ActiveSheet.Cells(ez + 1, 11) = ActiveSheet.Cells(ez, 11) + 1
ActiveSheet.Cells(ez + 1, 13) = ActiveSheet.Cells(ez, 13) + 1
ActiveSheet.Cells(ez + 1, 3) = Mw
ActiveSheet.Cells(ez + 1, 4) = Mmin
ActiveSheet.Cells(ez + 1, 6) = Fw
ActiveSheet.Cells(ez + 1, 7) = Fmax
ActiveSheet.Cells(ez + 1, 9) = Ww
ActiveSheet.Cells(ez + 1, 10) = Wmin
ActiveSheet.Cells(ez + 1, 12) = Kw
ActiveSheet.Cells(ez + 1, 14) = IG
ActiveSheet.Cells(ez + 1, 15) = Gw
End If
'ZahlenFormat
With ActiveSheet.Range(Cells(4, 3), Cells(ez + 1, 4))
.Style = "Percent"
.NumberFormat = "0.00%"
End With
With ActiveSheet.Range(Cells(4, 6), Cells(ez + 1, 7))
.Style = "Percent"
.NumberFormat = "0.00%"
End With
With ActiveSheet.Range(Cells(4, 9), Cells(ez + 1, 10))
.Style = "Percent"
.NumberFormat = "0.00%"
End With
ActiveSheet.Cells(ez + 1, 12).NumberFormat = "0.00"
ActiveSheet.Cells(ez + 1, 14).NumberFormat = "0.00"
ActiveSheet.Cells(ez + 1, 15).NumberFormat = "0.00"
'Muskeln auswerten
'Range r
Set r = ActiveSheet.Range(Cells(4, 3), Cells(ez + 1, 4))
'MinWertDiag MaxWertDiag
MinWertDiag = Application.WorksheetFunction.Min(r)
MaxWertDiag = Application.WorksheetFunction.Max(r)
a = MaxWertDiag - MinWertDiag
b = a / 4
g = Application.WorksheetFunction.RoundDown(MinWertDiag - b, 2)
d = Application.WorksheetFunction.RoundUp(MaxWertDiag + b, 2)
'Diagramm Muskelanteil aktualisieren
Set c = ActiveWorkbook.Charts("Muskelanteil")
With c
.ChartType = xlXYScatterLinesNoMarkers
.SetSourceData Source:=Worksheets("Daten").Range(Worksheets("Daten").Cells(3, 2), _
Worksheets("Daten").Cells(ez + 1, 4))
.PlotBy = xlColumns
'DataLabel des vorletzten Punktes im Diagramm löschen
With .SeriesCollection(1)
.DataLabels.Delete
.ApplyDataLabels
For lngPunkt = 1 To .Points.Count - 1
.Points(lngPunkt).DataLabel.Delete
Next lngPunkt
.points(.points.count).DataLabel.Text = Worksheets("Daten").Cells(ez + 1, 3).Value
.DataLabel.NumberFormat = "0.00%"
End With
End With
Set c = Nothing
Mir geht es nur darum dass du mehr von dem Code siehst...
Der fett markierte Teil ist mein Versuch dem letzten Punkt das Datalabel zuzuweisen und dann zu formatieren...
Du hast gemeint man soll dem ganzen Graph das Datalabel zuweisen und die nicht benötigten löschen.
With .SeriesCollection(1)
.DataLabels.Delete
.ApplyDataLabels
zuerst löschst du alle "Reste", dann kommt .ApplyDataLabels, danach werden alle nicht benötigten DataLabels gelöscht.
Mir ist leider nicht klar wo meine Formatierungsanweisung "DataLabel.NumberFormat="0.00%"" hin soll.
Ich habe es versucht, aber ohne Erfolg.
Vielleicht könntest du mir noch mal auf die Sprünge helfen?
Vielen Dank!!
Viele Grüße,
Jörg

Anzeige
AW: DataLabel formatieren
28.02.2016 09:43:01
Beverly
Hi Jörg,
habe leider vom Forum keine Benachrichtigung über deinen Beitrag erhalten.
Normalerweise nimmt Excel automatisch das Format der Originaldaten. Falls das nicht der Fall sein sollte oder die Ausgangsdaten ein anderes Format haben, musst du einfach die folgende Zeile vor der Schleife ergänzen:
        .DataLabels.NumberFormat = "0.00%"

AW: DataLabel formatieren
28.02.2016 18:33:25
Jörg
Hallo Karin,
ich habe den Fehler gefunden!! (Habe meine Korrektur fett markiert).
Es trat nämlich ein Fehler auf wenn die Datenreihe keine DataLabels enthält.
Vielen, vielen Dank nochmals für deine Hilfe!!!
Viele Grüße,
Jörg
'Diagramm Muskelanteil aktualisieren
Set c = ActiveWorkbook.Charts("Muskelanteil")
With c
.ChartType = xlXYScatterLinesNoMarkers
.SetSourceData Source:=Worksheets("Daten").Range(Worksheets("Daten").Cells(3, 2), Worksheets("Daten").Cells(ez + 1, 4))
.PlotBy = xlColumns
With .SeriesCollection(1)
If .HasDataLabels = True Then .DataLabels.Delete
.ApplyDataLabels
.DataLabels.NumberFormat = "0.00%"
For Punkt = 1 To .Points.Count - 1
.Points(Punkt).DataLabel.Delete
Next Punkt
End With
End With
Anzeige

Links zu Excel-Dialogen

Label TextBox

Beliebteste Forumthreads (12 Monate)

Anzeige
Jetzt das Excel-Portal bewerten: Deine Stimme zählt!

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige