如何使用VBA將ShapeStyle應用於Excel中圖表的特定系列？

Question

如何使用vba以編程方式將ShapeStyle應用於圖表的單個系列中的一組點？看來我需要一個「Shapes」對象，它只包含我想要格式化的系列中的點？

有些信息是在這裏：下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 

Answer 1

就像我在我的評論中提到的（而我可能是錯的）DataLabel沒有形狀屬性可以讓你改變.ShapeStyle。不過，我設法用一個複雜的例程來實現你想要的。

LOGIC

1. 插入一個臨時的形狀，比如在工作表
2. 矩形應用.ShapeStyle這種形狀
3. 單獨設置的DataLabel的性能，如填寫，邊框顏色，邊框樣式，影子等等。
4. 完成後，刪除形狀。

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

只設置一些.Fill性質使我這個爲msoShapeStylePreset38