4

如何使用 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
4

1 回答 1

5

就像我在评论中提到的（我可能是错的），没有可用的 shape 属性可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

在此处输入图像描述

于 2012-09-21T15:02:25.437 回答