Rotacionar programaticamente um gráfico de pizza para corrigir os rótulos

Question

Parte 1

Eu estou olhando para uma maneira de girar automaticamente (com VBA) um gráfico de pizza, dependendo dos dados. Os dados são alterados dinamicamente, dependendo do mês selecionado. Aqui está um exemplo do tipo de resultado que posso obter:

Comovocêpodever,osrótulos,mesmocomoajusteautomáticointegrado(melhorajuste)noExcel,nãoestãocomboaaparência.Issoocorreporquenãohámuitoespaçosobográficoparacolocarosrótulos.Naverdade,comoéumcírculoemumquadrado,semprehaverámaisespaçonoscantos.Vejacomoficacomumarotaçãode30°aplicadamanualmenteaográfico,aindacomosrótulosmaisadequados:

Sevocêécomoeu,vocêencontraráosegundográficodepizzacommelhoraparênciadoqueoprimeiro.

Agora,issoéfácil,tudooquepreciseifazerparacorrigiroproblemafoiadicionarumarotaçãode30°aográfico,masosdadosdográficosãocarregadosdinamicamente,àsvezeseuprecisode30°,outrasvezeseleserá270°.Oproblemasóocorrequandoháváriaspequenasfatias,comonoexemploacima.

Existeumamaneira,programaticamente,dependendodosdados,paralocalizarondeoExcelcolocaráaspequenasfatiasnográficodepizzade360ºeaplicaráarotaçãoapropriadaquandohouver3fatiaspequenasconsecutivas(3oumaisfatiascomumtotalinferiora10%)?

Parececomplicadofazerisso,enãoentendoporqueoExcelnãofazissoautomaticamente,masdevehaverumjeito.

Parte2

Resolvaprogramaticamenteessetipodeproblema:

Tivequemoverasetiquetasmanualmenteparaobteralgodebom:

Vejaumtrechodecódigoparamoverosrótulosparaevitarcontatoentreeles.Euprovavelmentepoderiafazerotrabalhoparaasituação#2,masaindaébastantecomplicado.Eledetectacolisõesentreosrótulosfazendoumlooprecursivoemovendoosrótulosumdooutroporalgunspixelsatéquenãoestejamaisemcolisão.Masmesmoolhandoparaqualladoestáemcolisãocomoutrorótulo,movê-loparaoladoopostopodelevaraumresultadopior.Esehouver4-5rótulosnamesmazona,afunçãorecursivademoraumaeternidadeparaserexecutadacomalgunsresultadosaleatórios.Eunãoquerocolocar100horasdetrabalhoparadesenvolverumalgoritmomelhorsehouverumasoluçãomelhoroujáexistente.

SubMoveLabels(chartIDAsInteger)OnErrorResumeNextDimshAsWorksheetDimchAsChartDimsersAsSeriesCollectionDimserAsSeriesDimiAsLong,ptAsLongDimdLabels()AsDataLabelSetsh=ActiveSheetSetch=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