以编程方式旋转饼图以固定标签

Question

第1部分

我正在寻找一种根据数据自动旋转（使用 VBA）饼图的方法。数据会根据所选月份动态更改。以下是我可以得到的结果类型的示例：

如您所见，即使使用内置的自动调整功能，标签（最合适)，看起来不太好。这是因为图表下方没有太多空间放置标签。实际上，由于它是正方形中的圆形，所以角落总会有更多空间。这是手动将 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