Question

我创建了一个宏，如果该点的值小于1且不同于0，则会向chartPoint添加箭头
该代码可以正常工作，但是在尝试创建The Arrow时，出现错误“ Object Required”，并且我没有设法选择该形状的头部并在那里创建箭头。

我要执行的操作在下图中描述

“验证结果并添加”箭头的代码如下

Sub fzerfgsdf()
 '
 '    fzerfgsdf Macro
 '

Dim clLeft As Double
Dim clTop As Double
Dim clWidth As Double
Dim clHeight As Double

Dim cl As Range
Dim shpOval As Shape

ActiveSheet.ChartObjects("Graphique 69").Activate
x = ActiveChart.SeriesCollection(1).Values
For i = LBound(x) To UBound(x)
  Debug.Print "Point "; i; "="; x(i)
  If x(i) < 1 And x(i) <> 0 Then
    ActiveChart.SeriesCollection(1).Points(i).Select


    Set cl = ActiveChart.SeriesCollection(1).Points(i).Select  '<-- Range("C2")

    clLeft = cl.Left
    clTop = cl.Top
    clHeight = 131.25
    clWidth = 579

    Set shpOval = ActiveSheet.Shapes.AddConnector(msoConnectorStraight, clLeft, clTop, 579, 131.25)
    shpOval.Select
    selection.ShapeRange.Line.EndArrowheadStyle = msoArrowheadOpen
    selection.ShapeRange.ShapeStyle = msoLineStylePreset20
  End If
Next i
End Sub

我找到了第一个创建形状的问题的解决方案，但我不知道如何在使用特定值的蓝色图表看到图像的正确位置找到该形状

Sub fzerfgsdf()
 '
' fzerfgsdf Macro
 '
ActiveSheet.ChartObjects("Graphique 69").Activate
 x = ActiveChart.SeriesCollection(1).Values
For i = LBound(x) To UBound(x)
Debug.Print "Point "; i; "="; x(i)
If x(i) < 1 And x(i) <> 0 Then
ActiveSheet.ChartObjects("Graphique 69").Activate
  ActiveChart.SeriesCollection(1).Points(i).Select
Dim clLeft As Double
Dim clTop As Double
Dim clWidth As Double
Dim clHeight As Double

Dim cl As Point
Dim shpOval As Shape

Set cl = ActiveChart.SeriesCollection(1).Points(i)  '<-- Range("C2")

clLeft = cl.Left
 clTop = cl.Top
 clHeight = 131.25
 clWidth = 579

  Set shpOval = ActiveSheet.Shapes.AddConnector(msoConnectorStraight, 
  clLeft, 
   clTop, 579, 131.25)
   shpOval.Select
   selection.ShapeRange.Line.EndArrowheadStyle = msoArrowheadOpen
  selection.ShapeRange.ShapeStyle = msoLineStylePreset20
  End If
 Next i
 End Sub

有人可以解决这个问题吗？

最佳问候波兰人

Answer 1

Public Sub fzerfgsdf()
    '
    ' fzerfgsdf Macro
    '
    Dim ws As Excel.Worksheet
    Dim chrt As Excel.Chart
    Dim sries As Excel.Series
    Dim x As Variant
    Dim clLeft As Double, clTop As Double
    Dim clWidth As Double, clHeight As Double
    Dim clBeginX As Double, clBeginY As Double, clEndX As Double, clEndY As Double
    Dim cl As Excel.Point
    Dim shpOval As Excel.Shape
    Dim dl As Excel.DataLabel
    Dim i As Long

    clHeight = 30
    clWidth = 15

    Set ws = Application.ActiveSheet
    Set chrt = ws.ChartObjects("Graphique 69").Chart
    Set sries = chrt.SeriesCollection(1)
    x = sries.Values
    For i = LBound(x) To UBound(x)
        Debug.Print "Point "; i; "="; x(i)
        If (x(i) < 1) And (x(i) <> 0) Then
            Set cl = sries.Points(i)
            With chrt.ChartArea
                clBeginX = IIf(.Left + cl.Left - clWidth < 0, 0, .Left + cl.Left - clWidth)
                clBeginY = IIf(.Top + cl.Top - clHeight < 0, 0, .Top + cl.Top - clHeight)
                clEndX = .Left + cl.Left
                clEndY = .Top + cl.Top
            End With

            Set shpOval = ws.Shapes.AddConnector(msoConnectorStraight, clBeginX, clBeginY, clEndX, clEndY)
            shpOval.Line.EndArrowheadStyle = msoArrowheadOpen
            shpOval.ShapeStyle = msoLineStylePreset20

            cl.HasDataLabel = True
            sries.HasLeaderLines = False
            Set dl = cl.DataLabel
            With dl
                .Text = "RFT 93%=> 5P"
                .Position = xlLabelPositionAbove
                .Format.AutoShapeType = msoShapeRectangularCallout
                .Format.Line.Visible = msoFalse
                .Top = cl.Top - clHeight - .Height - 5
                .Left = cl.Left - clWidth - (.Width / 2)
                With .Format.TextFrame2.TextRange.Font
                    .Size = 12
                    .Fill.ForeColor.RGB = RGB(255, 0, 0)
                    .Bold = msoTrue
                End With
            End With
        End If
    Next

    Set shpOval = Nothing
    Set cl = Nothing
    Set sries = Nothing
    Set chrt = Nothing
    Set ws = Nothing
End Sub

将连接器链接到ChartPoint VBA

1 个答案: