Функция внешнего вида VBA

Question

следующий код предназначен для создания круговой диаграммы (круглая диаграмма с круговыми диаграммами в виде пузырей). Он рекурсивно копирует круговую диаграмму в пузырьковую диаграмму. Моя проблема в том, что с помощью этого метода финальные круговые диаграммы выглядят немного овальными, а не крутыми. Проблема, которую я подозреваю, связана с каким-то форматированием.

Sub PieMarkers() 

Dim chtMarker As Chart 
Dim chtMain As Chart 
Dim intPoint As Integer 
Dim rngRow As Range 
Dim lngPointIndex As Long 
Dim thmColor As Long 
Dim myTheme As String 


Application.ScreenUpdating = False 
Set chtMarker = ActiveSheet.ChartObjects("chtMarker").Chart 
Set chtMain = ActiveSheet.ChartObjects("chtMain").Chart 

Set chtMain = ActiveSheet.ChartObjects("chtMain").Chart 
Set rngRow = Range(ThisWorkbook.Names("PieChartValues").RefersTo) 

For Each rngRow In Range("PieChartValues").Rows 
    chtMarker.SeriesCollection(1).Values = rngRow 
    ThisWorkbook.Theme.ThemeColorScheme.Load GetColorScheme(thmColor) 
    chtMarker.Parent.CopyPicture xlScreen, xlPicture 
    lngPointIndex = lngPointIndex + 1 
    chtMain.SeriesCollection(1).Points(lngPointIndex).Paste 
    thmColor = thmColor + 1 
Next 

lngPointIndex = 0 

Application.ScreenUpdating = True 
End Sub 

Function GetColorScheme(i As Long) As String 
Const thmColor1 As String = "C:\Program Files\Microsoft Office\Document Themes 15\Theme Colors\Blue Green.xml" 
Const thmColor2 As String = "C:\Program Files\Microsoft Office\Document Themes 15\Theme Colors\Orange Red.xml" 
    Select Case i Mod 2 
     Case 0 
      GetColorScheme = thmColor1 
     Case 1 
      GetColorScheme = thmColor2 
    End Select 
End Function 

Я обнаружил, что проблема разрешима, если дважды щелкнуть по ubble выбора описывается особых точки данных формата и затем заполнить и опции натяжных (возможно только при выборе заполнения картинки). Проблема в том, что мои данные меняются, и мне нужен динамический способ реализовать это в вышеупомянутом коде. Есть ли способ сделать это?

Я имею в виду эту консоль здесь http://s1.directupload.net/file/d/3300/7dlimc3g_png.htm

Answer 1

Я думаю, что это может быть проблемой, если ваш график Pie не идеально квадратной формы. Я могу реплицировать вашу проблему, и даже когда я проверяю опции Fill, смещения - все 0%. Я могу настроить их, но это не надежный способ сделать это. Итак, лучший вариант, я думаю, будет состоять в том, чтобы ваша круговая диаграмма .Parent была квадратной фигурой. Для этого перед вами CopyPicture, установите его Height равна его Width, как это:

chtMarker.Parent.Height = chtMarker.Parent.Width '## Ensure the chartObject is a square, so it will not be distorted when pasted. 
chtMarker.Parent.CopyPicture xlScreen, xlPicture