График данных метки ада

Question

Я столкнулся с довольно обостряющейся проблемой с макросом, который масштабирует размер шрифта в диаграммах. Как работает инструмент большего размера, наша компания имеет два разных шаблона 16x9 - один с размерами 10x5,62, а другой с размерами 13,33x7,5. Когда слайды из этих двух шаблонов объединяются, PowerPoint выполняет паршивую работу по масштабированию контента.

Таким образом, общий инструмент, который отлично работает, за исключением этой одной проблемы, создает копию активной презентации, изменяет ее размеры до 10x5,62, а затем проходит через каждую фигуру в презентации и делает положение / размер и размер шрифта ровно 75% от первоначальной презентации. Я могу предположить сравнение А / Б между всеми фигурами, потому что презентации Source и Destination идентичны, за исключением размера страницы.

Единственная проблема состоит в том, что когда инструмент обрабатывает диаграммы - некоторые диаграммы (но не все или даже большинство) сообщают о неправильном размере шрифта для определенных элементов. то есть размер кажется установленным на 13,3 в пользовательском интерфейсе, но объектная модель сообщает 18. В результате, когда происходит умножение размера шрифта, новый размер шрифта слишком велик. Полный инструмент обрабатывает заголовки диаграмм, названия осей, элементы легенд и метки данных по отдельности - но для простоты я просто включаю подпрограмму, которая обрабатывает метки диаграмм:

Sub RefontsizeChartLabels(dChrt As Chart, sChrt As Chart)

On Error GoTo Errhandler

Dim i As Integer
Dim j As Integer

Dim dSeriesVar As Series
Dim sSeriesVar As Series
Dim dDataLabelsVar As DataLabel
Dim sDataLabelsVar As DataLabel
Dim dPointVar As Point
Dim sPointVar As Point
Dim destRange2 As TextRange2
Dim sourceRange2 As TextRange2

Dim isAutoText As Boolean


For i = 1 To dChrt.SeriesCollection.Count
    Set dSeriesVar = dChrt.SeriesCollection(i)
    Set sSeriesVar = sChrt.SeriesCollection(i)
    For j = 1 To dSeriesVar.Points.Count
        Set dPointVar = dSeriesVar.Points(j)
        Set sPointVar = sSeriesVar.Points(j)
        If dPointVar.HasDataLabel = True Then
            Set sDataLabelsVar = sSeriesVar.DataLabels(j)
            Set dDataLabelsVar = dSeriesVar.DataLabels(j)
            isAutoText = dDataLabelsVar.AutoText
            Set destRange2 = dDataLabelsVar.Format.TextFrame2.TextRange
            Set sourceRange2 = sDataLabelsVar.Format.TextFrame2.TextRange
            RefontsizeChartShapeRange destRange2, sourceRange2
            dDataLabelsVar.AutoText = isAutoText
        End If
    Next
Next

Exit Sub

Errhandler:
    Debug.Print "Error: " & Err.Description

End Sub 

Просто для полноты, Вы можете видеть, что подпрограмма RefontsizeChartShapeRange выполняет простую операцию умножения со свойством .Font.Size

Public Sub RefontsizeChartShapeRange(destRange2 As TextRange2, sourceRange2 As TextRange2)

Debug.Print "IN_RefontsizeChartShapeRange"
On Error GoTo Errhandler

Dim i As Long

With destRange2.Font
    .Size = sourceRange2.Font.Size * scaleConstant
End With

Exit Sub

Errhandler:
Debug.Print "Error: " & Err.Description

End Sub

Сначала я думал, что это как-то связано с установленным свойством Autoscale, но возиться с ним казалось, ничего не исправить. Пошаговое выполнение кода, по-видимому, означает, что простой поиск определенных элементов диаграммы с помощью VBA и / или запись их в переменные выводит из строя саму объектную модель. Работа с dDataLabelsVar.AutoText, описанная выше, была обходным путем для одной проблемы, с которой у меня были метки данных, теряющие форматирование чисел после изменения размера шрифта, но это не устраняет проблему с отдельными метками, говоря, что они появляются в 18 баллов, когда появляются быть 13.3.

Любая помощь будет высоко ценится.