Excel

Nützliche VBA Scripte für MS Excel.

Stapelbalkendiagramme mit Prozentwerten markieren.

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