Расположение меток на кольцевой диаграмме

У меня есть следующий код, который пытается добавить метку данных к точке в комбинированной кольцевой/круговой диаграмме:

    For Each co In .ChartObjects
        With co.Chart.FullSeriesCollection("Grøn pil").Points(2)
            .HasDataLabel = True
            With .DataLabel
                .Position = xlLabelPositionOutsideEnd
                .Format.AutoShapeType = msoShapeRectangle
                .Format.Line.Visible = msoTrue
            End With
        End With
    Next co

Однако код прерывается на строке .Position = xlLabelPositionOutsideEnd с сообщением об ошибке «Ошибка времени выполнения 2147467259 (80004005)». Не удалось выполнить метод «Позиция» объекта «DataLabel».

Глядя на диаграмму, метка была добавлена, но она все еще находится внутри диаграммы.

введите здесь описание изображения

Как видите, я уже разместил метку за пределами диаграммы для другого ряда, который представлен в виде круговой диаграммы. В то время как серия, к которой я пытаюсь добавить метку, представлена ​​​​в виде кольцевой диаграммы.

Разве я не могу иметь обе этикетки для пончиковой и круговой диаграммы снаружи? Разве xlLabelPositionOutsideEnd не является допустимой позицией для меток кольцевой диаграммы? Или проблема в чем-то другом, что ускользает от меня?

Любая помощь будет принята с благодарностью!


excel vba excel-2016 excel-charts
person eirikdaude    schedule 06.03.2019    source источник

Ответы (2)


arrow_upward
2
arrow_downward

Я не думаю, что возможно сделать именно то, что вы хотите сделать так, как вы хотите! Параметр размещения меток за пределами диаграммы недоступен для параметров кольцевой диаграммы:

Отсутствующие параметры на кольцевой диаграмме

как на круговой диаграмме:

Параметры позиции метки на круговой диаграмме

Однако вы можете выполнить трюк, используя круговую диаграмму и белый кружок, чтобы сделать его похожим на пончик, выполнив следующие действия:

Sub AddCircle()
    'Get chart size and position:
        Dim CH01 As Chart: Set CH01 = ThisWorkbook.Sheets("Sheet1").ChartObjects("Chart1").Chart
        Dim OB01 As ChartObject: Set OB01 = CH01.Parent
        Dim x As Double: x = 0 'horizontal coordinate
        Dim y As Double: y = 0 'vertical coordinate
        Dim w As Double: w = 0 'width
        Dim h As Double: h = 0 'height
        x = OB01.Left
        y = OB01.Top
        w = OB01.Width
        h = OB01.Height
    'Adding the circle:
        ThisWorkbook.Sheets("Sheet1").Shapes.AddShape(msoShapeOval, x + w / 2 - 20, y + h / 2 - 20, 40, 40).Name = "Circle01"
    'Formatting the circle:
        With ThisWorkbook.Sheets("Sheet1").Shapes("Circle01")
            .LINE.Visible = msoFalse
            .Fill.ForeColor.RGB = RGB(255, 255, 255)
        End With
End Sub

И это работает очень хорошо:

Круговая диаграмма с отверстием

Было весело "решать" эту...

person Pspl    schedule 06.03.2019
comment
Спасибо - я искал это подменю в меню форматирования, чтобы посмотреть, какие у меня есть варианты - видимо, причина, по которой я не смог его найти, в том, что его там не было! В любом случае, я не думаю, что предложенное вами решение сработает для меня, но большое спасибо за усилия :-) - person eirikdaude; 06.03.2019
comment
Я знаю. Поскольку вы имеете дело с комбинированной диаграммой, этот прием может оказаться неправильным. Я разместил это только потому, что это было забавно (я такой ботаник...!). - person Pspl; 06.03.2019

arrow_upward
0
arrow_downward

Работая с синусом и косинусом, мы также можем рассчитать внешнее положение метки. Следуя фрагменту VB, как это можно сделать:

Sub Macro1()
    Dim cx
    Dim cy
    Dim x
    Dim y
    Dim radius
    Dim angle
    Dim new_radius
    Dim new_x
    Dim new_y

    ActiveSheet.ChartObjects("Chart 1").Activate
    ActiveSheet.ChartObjects("Chart 1").Select
    cx = Selection.width / 2
    cy = Selection.height / 2

    For i = 1 To ActiveChart.FullSeriesCollection(1).Points.Count Step 1
        ActiveChart.FullSeriesCollection(1).Points(i).DataLabel.Select
        x = Selection.left + (Selection.width / 2)
        y = Selection.top + (Selection.height / 2)
        radius = Sqr(((x - cx) ^ 2) + ((y - cy) ^ 2))
        angle = WorksheetFunction.Atan2(y - cy, x - cx)
        new_radius = radius + 40
        new_x = cx + (Sin(angle) * new_radius)
        new_y = cy + (Cos(angle) * new_radius)
        Selection.left = new_x - (Selection.width / 2)
        Selection.top = new_y - (Selection.height / 2)
    Next i
End Sub
person Chris    schedule 19.08.2019