如何编程使用VBA图表的一个系列应用ShapeStyle到一组点? 看来我需要的是包含从系列我试图格式化只点“形状”的对象?
有些信息是在这里: http://peltiertech.com/WordPress/programming-excel-2007-2010-autoshapes-with-vba/下的“设置边框和填充样式”部分
我有伪代码,但我不知道如何创建形状,只有我想在它的项目对象
' 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
这将让你改变.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
文章来源: How to apply ShapeStyle to a specific Series of a Chart in Excel using VBA?