Excel

Nützliche VBA Scripte für MS Excel.

Balken mit Prozentwerten beschriften

Fehler beim Erstellen des Vorschaubildes: Datei fehlt

Balkendiagramm mit %-Werten

MS Excel bietet keine Möglichkeit die einzelnen Balken in einem gestapelten Balkendiagramm mit den Prozent- statt absoluten Werten zu beschriften.

Dieses VBA-Makro beschriftet die einzelnen Balken in einem gestapelten Balkendiagramm mit den Prozentwerten. Vorausgesetzt wird, dass die Summe in der letzten Spalte steht (siehe Beispielbild). Die Summe eines Stapels ist über dem Stapel angezeigt.

Labels in Diagramm ändern

Sub PercentLabelChart(myChart As Chart)

Dim mySeries As Series
Dim SollSeries As Series
Dim myPoint As Point
Dim i, j As Long

If myChart.SeriesCollection.Count > 2 Then
    
   Set SollSeries = myChart.SeriesCollection(myChart.SeriesCollection.Count)
      
   For i = 1 To myChart.SeriesCollection.Count - 1
           
     Set mySeries = myChart.SeriesCollection(i)
        
     For j = 1 To mySeries.Points.Count
        
       Set myPoint = mySeries.Points(j)
        
       If myPoint.HasDataLabel Then
       ' myPoint.DataLabel.Text = Format(mySeries.Values(j), "0")
         myPoint.DataLabel.Text = Format(mySeries.Values(j) / SollSeries.Values(j), "0%")
       End If
        
     Next ' j
      
   Next ' i
    
End If

End Sub

Aktives Diagramm ändern

Sub ActiveChartPercentLabeling()

If Not ActiveChart Is Nothing Then
  
  Call PercentLabelChart(ActiveChart)
  
Else

  MsgBox "Bitte ein Diagramm auswählen!", vbOKOnly, "Fehler: Aktives Diagramm"
   
End If

End Sub

Alle Diagramme ändern

Sub ModifyAllCharts()
'
' ModifyAllCharts Makro
'
' Ausgangsbefehl
'
'     ActiveChart.SeriesCollection(1).Points(1).DataLabel.Text = "33305"
'
 
Dim mySheet As Worksheet

For Each mySheet In Worksheets

  If mySheet.ChartObjects.Count > 0 Then
    Call PercentLabelChart(mySheet.ChartObjects(1).Chart)
  End If
  
Next

End Sub