如何使用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
最佳答案
就像我在评论中提到的(可能是错误的),DataLabel
没有可用的shape属性,它可以让您更改.ShapeStyle
。但是,我设法使用复杂的例程来实现您想要的目标。
逻辑
插入一个临时形状,例如在工作表中说一个矩形
将.ShapeStyle
应用于此形状
根据形状分别设置DataLabel
的属性,例如“填充”,“边框颜色”,“边框样式”,“阴影”等。
完成后,删除形状。
码
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