如何使用VBA将ShapeStyle应用于Excel中的特定系列图表？ [英] How to apply ShapeStyle to a specific Series of a Chart in Excel using VBA?

问题描述

如何使用vba从单个图表系列中将ShapeStyle应用于一组点？看来我需要一个Shapes对象，它只包含我想要格式化的系列中的点？

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

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

 '将特定系列的图形应用于特定系列图
 
 Sub ApplyShapeStyle ch As As the Chart，sr As Series，ss As ShapeStyle）
 
'以某种方式创建一个Shapes对象，
'包含系列中所有的点作为Shape对象
 
 Dim shps as Shapes 
'pseudocode 
 shps.Add（<系列中的所有点>）
 shps.ShapeStyle = ss 
 
 End Sub 
  

我可能错了），没有可用的 DataLabel 它将让您更改 .ShapeStyle 。然而，我设法使用复杂的例程来实现你想要的。

LOGIC

1. 插入一个临时形状，在工作表中表示一个矩形


2. 将 .ShapeStyle 应用于此形状


3. 单独设置 DataLabel 的属性，如填充，边框颜色


4. 完成后，删除形状。

代码

 子示例（）
 Dim myChart As ChartObject 
 Dim chrt As Chart 
 Dim shp As Shape 
 Dim sr As Series 
 
设置myChart = ActiveSheet.ChartObjects（图1）
设置chrt = myChart.Chart 
 
'º·。添加一个临时Shape与所需的ShapeStyle 
 Set shp = ActiveSheet.Shapes.AddShape（msoShapeRectangle，100，100，100，100）
 shp.ShapeStyle = msoShapeStylePreset42 
 
设置sr = chrt.SeriesCollection（1）
 
'º·。填充
 Dim gs As GradientStop 
 Dim i As Integer 
 
如果shp.Fill.BackColor.ObjectThemeColor<> msoNotThemeColor然后
 sr.Format.Fill.BackColor.ObjectThemeColor = shp.Fill.BackColor.ObjectThemeColor 
 End If 
如果shp.Fill.ForeColor.ObjectThemeColor<> msoNotThemeColor然后
 sr.Format.Fill.ForeColor.ObjectThemeColor = shp.Fill.ForeColor.ObjectThemeColor 
结束If 
选择案例shp.Fill.Type 
案例msoFillGradient 
 '必须首先设置渐变，否则可能无法设置gradientangle 
 sr.Fill.TwoColorGradient shp.Fill.GradientStyle，shp.Fill.GradientVariant 
 sr.Format.Fill.GradientAngle = shp.Fill .GradientAngle 
 
'尽可能删除预先存在的渐变停止点。
 Do While（sr.Format.Fill.GradientStops.Count> 2）
 sr。 Format.Fill.GradientStops.Delete sr.Format.Fill.GradientStops.Count 
循环
 
对于i = 1 To shp.Fill.GradientStops.Count 
设置gs = shp。 Fill.GradientStops（i）
 
如果i< 3然后
 sr.Format.Fill.GradientStops.Insert gs.Color，gs.Position，gs.Transparency，i 
'...然后删除最后两个停止，以前不能删除
 sr.Format.Fill.GradientStops.Delete 3 
 Else 
 sr.Format.Fill.GradientStops.Insert gs.Color，gs.Position，gs.Transparency，i 
 End If 
 Next i 
 
案例msoFillSolid 
 sr.Format.Fill.Solid 
 
'NYI 
案例msoFillBackground 
案例msoFillMixed 
案例msoFillPatterned 
案例msoFillPicture 
案例msoFillTextured 
结束选择
 
 sr.Format.Fill.Transparency = shp.Fill.Transparency 
 
'º·。行
如果shp.Line.Visible然后
 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 
 
'一些格式化例如不支持箭头
 End If 
 sr.Format.Line.Visible = shp.Line.Visible 
 
'º·。发光
如果shp.Glow.Radius> 0然后
 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 
 
'º·。阴影是痛苦的
'看http://stackoverflow.com/questions/10178990/turn-off-marker-shadow-on-vba-generated-excel-plots 
如果shp.Shadow.Visible然后
 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 
'请注意，这不起作用预期... 
 sr.Format.Shadow.Visible = msoFalse 
'...但这种类型的
 sr.Format.Shadow.Transparency = 1 
结束If 
 
'º·。 SoftEdge 
 sr.Format.SoftEdge.Radius = shp.SoftEdge.Radius 
 sr.Format.SoftEdge.Type = shp.SoftEdge.Type 
 
'º·。 3d Effects 
如果shp.ThreeD.Visible然后
 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 $ a 
 
 sr.Format.ThreeD.FieldOfView = shp.ThreeD.FieldOfView 
 sr.Format.ThreeD.LightAngle = shp.ThreeD.LightAngle 
 sr.Format.ThreeD.Perspective = shp.ThreeD。透视图
 sr.Format.ThreeD.P rojectText = 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 
 
'º·。清理
 shp.Delete 
 
 End Sub 
  

SCREENSHOT

只需设置一些 .Fill 属性，就可以为 msoShapeStylePreset38

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

解决方案

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

1. Insert a temporary shape, say a rectangle in the worksheet
2. Apply the .ShapeStyle to this shape
3. Individually set the properties of DataLabel like Fill, Border color, Border Style, Shadow etc with that from the shape.
4. 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

这篇关于如何使用VBA将ShapeStyle应用于Excel中的特定系列图表？的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！