Программно вращайте круговую диаграмму, чтобы исправить метки

Question

Часть 1

Я ищу способ автоматического поворота (с VBA) круговой диаграммы в зависимости от данных. Данные изменяются динамически в зависимости от выбранного месяца. Вот пример результата, который я могу получить:

Как видите, метки, даже с помощью встроенной автоматической настройки (лучше всего подходят) в Excel, выглядят не очень хорошо. Это потому, что под диаграммой не так много места для размещения меток. На самом деле, поскольку это квадрат в квадрате, в углах всегда будет больше места. Вот как это выглядит при повороте на 30 ° вручную, все еще с метками наилучшего соответствия :

Если вы похожи на меня, вы увидите, что вторая круговая диаграмма выглядит лучше, чем первая.

Теперь это легко, все, что мне нужно было сделать, чтобы решить мою проблему, это добавить поворот на 30 ° к диаграмме, но данные диаграммы загружаются динамически, иногда мне понадобится 30 °, в других случаях это будет 270 °. Проблема возникает только тогда, когда есть несколько маленьких кусочков, как в примере выше.

Есть ли способ, программно, в зависимости от данных, найти, куда Excel собирается поместить маленькие кусочки в круговую диаграмму 360 °, а затем применить соответствующее вращение, когда есть 3 последовательных маленьких кусочка (3 или более кусочков с общим количеством менее 10%)?

Это выглядит сложно сделать, и я не понимаю, почему Excel не делает это автоматически, но должен быть способ.

---

Часть 2

Программно решить эту проблему:

Мне пришлось переместить ярлыки вручную, чтобы получить что-то красивое:

Вот некоторый кусок кода, чтобы переместить метки, чтобы избежать контакта друг с другом. Я мог бы, вероятно, заставить это работать для ситуации # 2, но это все еще довольно сложно. Он обнаруживает коллизии между метками, рекурсивно зацикливая и перемещая метки друг от друга на пару пикселей, пока они больше не будут в коллизии. Но даже смотря на то, какая сторона находится в столкновении с другой этикеткой, перемещение ее на противоположную сторону может привести к худшему результату. И если в одной зоне 4-5 меток, рекурсивная функция работает вечно с некоторыми случайными результатами. Я не хочу потратить 100 часов на разработку лучшего алгоритма, если есть лучшее или уже существующее решение.

Sub MoveLabels(chartID As Integer)
    On Error Resume Next
    Dim sh As Worksheet
    Dim ch As Chart
    Dim sers As SeriesCollection
    Dim ser As Series
    Dim i As Long, pt As Long
    Dim dLabels() As DataLabel

    Set sh = ActiveSheet
    Set ch = sh.ChartObjects("Chart " & chartID).Chart

    Set sers = ch.SeriesCollection
    sers(1).DataLabels.Position = xlLabelPositionBestFit

    ReDim dLabels(1 To sers(1).Points.Count)
    For i = 1 To sers(1).Points.Count
        Set dLabels(i) = sers(1).Points(i).DataLabel
    Next
    AdjustLabels dLabels
    On Error GoTo 0
End Sub

Sub AdjustLabels(ByRef v() As DataLabel)
    Dim i As Long, j As Long
    Dim ptMove As Integer

    'A label will be moved recursively by that many pixel until it avoids contact
    'More pixels is faster, less pixels is more accurate
    ptMove = 10 

    For i = LBound(v) To UBound(v) - 1
    For j = LBound(v) + 1 To UBound(v)
        If v(i).Left <= v(j).Left Then
            If v(i).Top <= v(j).Top Then
                If (v(j).Top - v(i).Top) < v(i).Height And (v(j).Left - v(i).Left) < v(i).Width And v(j).Text <> v(i).Text And v(j).Text <> "" And v(i).Text <> "" Then
                    v(i).Left = v(i).Left - ptMove
                    v(j).Left = v(j).Left + ptMove
                    AdjustLabels v
                End If
            Else
                If (v(i).Top - v(j).Top) < v(j).Height And (v(j).Left - v(i).Left) < v(i).Width And v(j).Text <> v(i).Text And v(j).Text <> "" And v(i).Text <> "" Then
                    v(i).Left = v(i).Left - ptMove
                    v(j).Left = v(j).Left + ptMove
                    AdjustLabels v
                End If
            End If
        Else
            If v(i).Top <= v(j).Top Then
                If (v(j).Top - v(i).Top) < v(i).Height And (v(i).Left - v(j).Left) < v(j).Width And v(j).Text <> v(i).Text And v(j).Text <> "" And v(i).Text <> "" Then
                    v(i).Left = v(i).Left + ptMove
                    v(j).Left = v(j).Left - ptMove
                    AdjustLabels v
                End If
            Else
                If (v(i).Top - v(j).Top) < v(j).Height And (v(i).Left - v(j).Left) < v(j).Width And v(j).Text <> v(i).Text And v(j).Text <> "" And v(i).Text <> "" Then
                    v(i).Left = v(i).Left + ptMove
                    v(j).Left = v(j).Left - ptMove
                    AdjustLabels v
                End If
            End If
        End If
    Next j, i
End Sub