Domine o Excel ® (3 em 1): Excel - 70 Fórmulas Incríveis, Excel - 51 Macros incríveis e 51 Dicas e Truques Incríveis

Sub AjustGraphic()
For i = 1 To ActiveSheet.ChartObjects.Count
ActiveSheet.ChartObjects(i).Select
Dim MaxScale, MinScale, MyPoint, DefaultPosition, AdjustedPosition As
Long
Dim MySeries As Series
Dim PointsArray As Variant
With ActiveChart
MaxScale = .Axes(xlValue).MaximumScale
MinScale = .Axes(xlValue).MinimumScale
For Each MySeries In .SeriesCollection
If MySeries.ChartType <> xlColumnClustered And
MySeries.ChartType <> xlLine And
MySeries.ChartType <> xlLineMarkers Then
GoTo NEXTSERIES
End If
PointsArray = MySeries.Values
For MyPoint = LBound(PointsArray) To UBound(PointsArray)
If MySeries.Points(MyPoint).HasDataLabel = False Then
GoTo NEXTDOT
End If
If MySeries.ChartType = xlColumnClustered Then
MySeries.Points(MyPoint).DataLabel.Position =
xlLabelPositionOutsideEnd
If PointsArray(MyPoint) > MaxScale * 0.9 Then
MySeries.Points(MyPoint).DataLabel.Position =
xlLabelPositionInsideEnd
End If
End If
If MySeries.ChartType = xlLine Or MySeries.ChartType =
xlLineMarkers Then
MySeries.Points(MyPoint).DataLabel.Position = xlBelow
If MyPoint > 1 Then
If PointsArray(MyPoint) > PointsArray(MyPoint - 1) Then
MySeries.Points(MyPoint).DataLabel.Position = xlAbove