Bubble Chart: VBA neues Textfeld & RGB Farben

Hallo,
ich habe 2 Probleme:
1. Neues!, zentriertes Textfeld in einem Bubblechart erstellen und Text auslesen
Ausgangslage:
a) Es existiert ein Bubblechart in dem die Bubblegröße zentriert angezeigt wird (siehe Beispiel).
b) Mittels eines Makros (aus dem Forum) lassen ich Text (Beschriftung) aus einer Spalte einlesen.
Problem: Das Makro nimmt das Textfeld in dem vorher die Bubblegröße stand und erzeugt kein neues, ebenfalls zentriertes Textfeld (Makro im Beispiel enthalten).
2. RGB-Farbzuweisung in einem Bubbelchart aus einer Spalte
Ziel: Es existiert ein Bubblechart (siehe Beispiel). Jeder Bubble soll die RGB-Farbe haben, die in der Spalte E steht.
Anmerkung: Per Google habe ich nur so etwas ähnliches gefunden (http://mollerhansen.blogspot.de/2013/02/excel-bubble-chart-macro.html) und bin leider zu unerfahren es zu adaptieren.
Beispiel: https://www.herber.de/bbs/user/98265.xlsm
Vielen Dank im Voraus
Susanne

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hi Susanne,
weshalb benötigst du ein extra Textfeld - du kannst doch sowohl den Wert als auch den Inhalt der Spalte A im Beschriftungslabel anzeigen lassen:

Sub Beschriftung()
Dim lngPunkt As Long
Dim strFormel As String
With ActiveSheet.ChartObjects(1).Chart.SeriesCollection(1)
strFormel = Application.Substitute(Split(.Formula, ",")(1), ")", "")
For lngPunkt = 1 To .Points.Count
.Points(lngPunkt).DataLabel.Text = Range(strFormel).Cells(lngPunkt).Offset(0, -1) _
& ": " & vbLf & Range(strFormel).Cells(lngPunkt).Offset(0, 2)
.Points(lngPunkt).DataLabel.Format.TextFrame2.TextRange.Font.Fill.ForeColor.RGB = _
RGB(0, 0, 0)
Next lngPunkt
End With
End Sub

Die Farbe kannst du wie folgt zuweisen:


Sub Farbe()
Dim lngPunkt As Long
Dim strFormel As String
Dim intR As Integer
Dim intG As Integer
Dim intB As Integer
With ActiveSheet.ChartObjects(1).Chart.SeriesCollection(1)
strFormel = Application.Substitute(Split(.Formula, ",")(4), ")", "")
For lngPunkt = 1 To .Points.Count
If Range(strFormel).Cells(lngPunkt).Offset(0, 1)  "" Then
intR = CInt(Split(Range(strFormel).Cells(lngPunkt).Offset(0, 1).Value, ",")(0))
intG = CInt(Split(Range(strFormel).Cells(lngPunkt).Offset(0, 1).Value, ",")(1))
ingb = CInt(Split(Range(strFormel).Cells(lngPunkt).Offset(0, 1).Value, ",")(2))
.Points(lngPunkt).Format.Fill.ForeColor.RGB = RGB(intR, intG, intB)
End If
Next lngPunkt
End With
End Sub

Sub Textfelder() Dim objText As Object Dim lngPunkt As Long Dim strFormel As String Dim rngZelle As Range Dim dblOben As Double Dim dblLinks As Double Application.ScreenUpdating = False With ActiveSheet.ChartObjects(1).Chart strFormel = Split(.SeriesCollection(1).Formula, ",")(1) For lngPunkt = 1 To .SeriesCollection(1).Points.Count dblOben = .SeriesCollection(1).Points(lngPunkt).DataLabel.Top dblLinks = .SeriesCollection(1).Points(lngPunkt).DataLabel.Left + _ .SeriesCollection(1).Points(lngPunkt).DataLabel.Width + 0.05 Set objText = .Shapes.AddTextbox(msoTextOrientationHorizontal, 0, 0, 0, 0) With objText .Top = dblOben .Left = dblLinks .TextFrame2.MarginLeft = 0 .TextFrame2.MarginRight = 0 .TextFrame2.MarginTop = 0 .TextFrame2.MarginBottom = 0 .TextFrame2.WordWrap = msoFalse .TextFrame2.AutoSize = msoAutoSizeShapeToFitText .DrawingObject.Formula = "=" & _ Range(strFormel).Cells(lngPunkt).Offset(0, -1).Address End With Next lngPunkt End With Set objText = Nothing Application.ScreenUpdating = False End Sub

Beliebteste Forumthreads (12 Monate)

Bubble Chart: VBA neues Textfeld & RGB Farben

6
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

309 Forumthreads zu ähnlichen Themen

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Bubble Chart: VBA neues Textfeld & RGB Farben

6 Beiträge zum Forumthread Beiträge zu diesem Forumthread

309 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

6
Beiträge zum Forumthread

Beiträge zu diesem Forumthread