How to apply ShapeStyle to a specific Series of a Chart in Excel using VBA?

问题

How do I programatically apply a ShapeStyle to a set of Points from a single Series of a Chart using vba? It seems I need a "Shapes" object that contains only the points from the series I am trying to format?

Some information is here: http://peltiertech.com/WordPress/programming-excel-2007-2010-autoshapes-with-vba/ under the "Setting Border and Fill Styles" section

I have pseudocode but I have no idea how to create the Shapes object with only the items I want in it

' Applies desired shapestyle to a specific series of a chart

Sub ApplyShapeStyle(ch As Chart, sr As Series, ss As ShapeStyle)

    ' Somehow create a "Shapes" object that 
    ' contains all the points from the series as Shape objects

    Dim shps as Shapes
    'pseudocode
    shps.Add(<all points from series>)
    shps.ShapeStyle = ss

End Sub

回答1:

Like I mentioned in my comment (And I could be wrong) there is no shape property available for the DataLabel which will let you change the .ShapeStyle. However I managed to achieve what you want using a complex routine.

LOGIC

Insert a temporary shape, say a rectangle in the worksheet
Apply the .ShapeStyle to this shape
Individually set the properties of DataLabel like Fill, Border color, Border Style, Shadow etc with that from the shape.
Once done, delete the shape.

CODE

Sub Sample()
Dim myChart As ChartObject
Dim chrt As Chart
Dim shp As Shape
Dim sr As Series

Set myChart = ActiveSheet.ChartObjects("Chart 1")
Set chrt = myChart.Chart

'º·. Add a temporary Shape with desired ShapeStyle
Set shp = ActiveSheet.Shapes.AddShape(msoShapeRectangle, 100, 100, 100, 100)
shp.ShapeStyle = msoShapeStylePreset42

Set sr = chrt.SeriesCollection(1)

'º·. Fill
Dim gs As GradientStop
Dim i As Integer

If shp.Fill.BackColor.ObjectThemeColor <> msoNotThemeColor Then
    sr.Format.Fill.BackColor.ObjectThemeColor = shp.Fill.BackColor.ObjectThemeColor
End If
If shp.Fill.ForeColor.ObjectThemeColor <> msoNotThemeColor Then
    sr.Format.Fill.ForeColor.ObjectThemeColor = shp.Fill.ForeColor.ObjectThemeColor
End If
Select Case shp.Fill.Type
    Case msoFillGradient
        ' Have to set the gradient first otherwise might not be able to set gradientangle
        sr.Fill.TwoColorGradient shp.Fill.GradientStyle, shp.Fill.GradientVariant
        sr.Format.Fill.GradientAngle = shp.Fill.GradientAngle

        'Removes pre-existing gradient stops as far as possible...
        Do While (sr.Format.Fill.GradientStops.Count > 2)
            sr.Format.Fill.GradientStops.Delete sr.Format.Fill.GradientStops.Count
        Loop

        For i = 1 To shp.Fill.GradientStops.Count
            Set gs = shp.Fill.GradientStops(i)

            If i < 3 Then
                sr.Format.Fill.GradientStops.Insert gs.Color, gs.Position, gs.Transparency, i
                ' ...and then removes last two stops that couldn't be removed earlier
                sr.Format.Fill.GradientStops.Delete 3
            Else
                sr.Format.Fill.GradientStops.Insert gs.Color, gs.Position, gs.Transparency, i
            End If
        Next i

    Case msoFillSolid
        sr.Format.Fill.Solid

    ' NYI
    Case msoFillBackground
    Case msoFillMixed
    Case msoFillPatterned
    Case msoFillPicture
    Case msoFillTextured
End Select

sr.Format.Fill.Transparency = shp.Fill.Transparency

'º·. Line
If shp.Line.Visible Then
    sr.Format.Line.ForeColor = shp.Line.ForeColor
    sr.Format.Line.BackColor = shp.Line.BackColor
    sr.Format.Line.DashStyle = shp.Line.DashStyle
    sr.Format.Line.InsetPen = shp.Line.InsetPen
    sr.Format.Line.Style = shp.Line.Style
    sr.Format.Line.Transparency = shp.Line.Transparency
    sr.Format.Line.Weight = shp.Line.Weight

    ' Some formatting e.g. arrowheads not supported
End If
sr.Format.Line.Visible = shp.Line.Visible

'º·. Glow
If shp.Glow.Radius > 0 Then
    sr.Format.Glow.Color = shp.Glow.Color
    sr.Format.Glow.Radius = shp.Glow.Radius
    sr.Format.Glow.Transparency = shp.Glow.Transparency
End If
sr.Format.Glow.Radius = shp.Glow.Radius

'º·. Shadows are a pain
' see http://stackoverflow.com/questions/10178990/turn-off-marker-shadow-on-vba-generated-excel-plots
If shp.Shadow.Visible Then
    sr.Format.Shadow.Blur = shp.Shadow.Blur
    sr.Format.Shadow.ForeColor = shp.Shadow.ForeColor
    sr.Format.Shadow.OffsetX = shp.Shadow.OffsetX
    sr.Format.Shadow.OffsetY = shp.Shadow.OffsetY
    sr.Format.Shadow.Size = shp.Shadow.Size
    sr.Format.Shadow.Style = shp.Shadow.Style
    sr.Format.Shadow.Transparency = shp.Shadow.Transparency
    sr.Format.Shadow.Visible = msoTrue
Else
    ' Note that this doesn't work as expected...
    sr.Format.Shadow.Visible = msoFalse
    ' ...but this kind-of does
    sr.Format.Shadow.Transparency = 1
End If

'º·. SoftEdge
sr.Format.SoftEdge.Radius = shp.SoftEdge.Radius
sr.Format.SoftEdge.Type = shp.SoftEdge.Type

'º·. 3d Effects
If shp.ThreeD.Visible Then
    sr.Format.ThreeD.BevelBottomDepth = shp.ThreeD.BevelBottomDepth
    sr.Format.ThreeD.BevelBottomInset = shp.ThreeD.BevelBottomInset
    sr.Format.ThreeD.BevelBottomType = shp.ThreeD.BevelBottomType
    sr.Format.ThreeD.BevelTopDepth = shp.ThreeD.BevelTopDepth
    sr.Format.ThreeD.BevelTopInset = shp.ThreeD.BevelTopInset
    sr.Format.ThreeD.BevelTopType = shp.ThreeD.BevelTopType
    sr.Format.ThreeD.ContourColor = shp.ThreeD.ContourColor
    sr.Format.ThreeD.ContourWidth = shp.ThreeD.ContourWidth
    sr.Format.ThreeD.Depth = shp.ThreeD.Depth
    sr.Format.ThreeD.ExtrusionColor = shp.ThreeD.ExtrusionColor
    sr.Format.ThreeD.ExtrusionColorType = shp.ThreeD.ExtrusionColorType
    sr.Format.ThreeD.FieldOfView = shp.ThreeD.FieldOfView
    sr.Format.ThreeD.LightAngle = shp.ThreeD.LightAngle
    sr.Format.ThreeD.Perspective = shp.ThreeD.Perspective
    sr.Format.ThreeD.ProjectText = shp.ThreeD.ProjectText
    sr.Format.ThreeD.RotationX = shp.ThreeD.RotationX
    sr.Format.ThreeD.RotationY = shp.ThreeD.RotationY
    sr.Format.ThreeD.RotationZ = shp.ThreeD.RotationZ
    sr.Format.ThreeD.Z = shp.ThreeD.Z
End If
sr.Format.ThreeD.Visible = shp.ThreeD.Visible

'º·. Cleanup
shp.Delete

End Sub

SCREENSHOT

Just Setting some of the .Fill properties gives me this for msoShapeStylePreset38