excel - 如何使用 VBA 将 ShapeStyle 应用于 Excel 中图表的特定系列？

Question

如何使用 vba 以编程方式将 ShapeStyle 应用于单个图表系列中的一组点？看来我需要一个“形状”对象，其中仅包含我尝试格式化的系列中的点？

一些信息在这里:http://peltiertech.com/WordPress/programming-excel-2007-2010-autoshapes-with-vba/在“设置边框和填充样式”部分下

我有伪代码，但我不知道如何创建仅包含我想要的项目的 Shapes 对象

' 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

Answer 1

就像我在评论中提到的(我可能是错的)，DataLabel 没有可用的形状属性，它可以让您更改 .ShapeStyle 。不过，我设法使用复杂的例程实现了您想要的目标。

逻辑

1. 插入临时形状，例如工作表中的矩形
2. 将 .ShapeStyle 应用于此形状
3. 单独设置DataLabel的属性，例如填充、边框颜色、边框样式、阴影 等与形状。
4. 完成后，删除形状。

代码

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

屏幕截图

只需设置一些 .Fill 属性即可为 msoShapeStylePreset38