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

私のコメントで述べたように (そして私は間違っているDataLabel可能性があります) 、 を変更できるようにするための形状プロパティはありません.ShapeStyle。ただし、複雑なルーチンを使用して、目的を達成することができました。

論理

  1. ワークシートに長方形などの一時的な形状を挿入します
  2. .ShapeStyleこの形状に を適用します
  3. Fill、Border color、Border Style、ShadowDataLabelなどのプロパティを形状から個別に設定します。
  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 に答える