Vba 图表数据标签地狱

Vba 图表数据标签地狱,vba,powerpoint,Vba,Powerpoint,我遇到了一个相当令人恼火的问题,一个宏在图表中缩放字体大小。更大的工具的工作方式是,我们公司有两个不同的16x9模板——一个使用10x5.62尺寸,另一个使用13.33x7.5尺寸。将这两个模板中的幻灯片组合在一起时,PowerPoint在缩放内容方面做得很糟糕 因此,除了这一个问题外,整个工具工作得很好,它复制了活动演示文稿,将其尺寸更改为10x5.62,然后遍历演示文稿中的每个形状,使位置/大小和字体大小正好为原始演示文稿的75%。我能够假设所有形状之间的A/B比较,因为除了页面大小之外,源

我遇到了一个相当令人恼火的问题,一个宏在图表中缩放字体大小。更大的工具的工作方式是,我们公司有两个不同的16x9模板——一个使用10x5.62尺寸,另一个使用13.33x7.5尺寸。将这两个模板中的幻灯片组合在一起时,PowerPoint在缩放内容方面做得很糟糕

因此,除了这一个问题外,整个工具工作得很好,它复制了活动演示文稿,将其尺寸更改为10x5.62,然后遍历演示文稿中的每个形状,使位置/大小和字体大小正好为原始演示文稿的75%。我能够假设所有形状之间的A/B比较,因为除了页面大小之外,源和目标演示文稿是相同的

一个问题是,当该工具处理图表时,某些图表(但不是全部或大部分)报告某些元素的字体大小不正确。i、 例如,在用户界面中,大小似乎设置为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 
为了完整起见,您可以看到REFORNTSIZECHARTSHAPERANGE子函数正在对.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
起初,我认为这与设置自动缩放属性有关,但搞乱它似乎并没有解决任何问题。逐步浏览代码似乎意味着,只需使用VBA搜索某些图表元素和/或将它们记录到变量中,就会使对象模型本身变得异常。上面关于dDataLabelsVar.AutoText的业务是我遇到的一个问题的一个解决办法,即数据标签在更改字体大小后丢失了数字格式,但它无法解决单个标签在显示为13.3时表示为18点的问题


任何帮助都将不胜感激。

如果没有进行此操作的甲板样本,就不可能为您的案例设置独立测试。FWIW,10“x5.62”是PowerPoint 2010中过时的尺寸。Microsoft现在将幻灯片尺寸设置为7.5英寸高,宽度可变。这可能会使您更容易在所有旧的幻灯片组上运行批量转换,因此您只需要处理13.33英寸x7.5英寸的幻灯片“继续。在做了更多的测试之后,我想我已经解决了这个问题:单个图表元素的许多格式属性都链接到了.chart.ChartArea.Font属性。链接属性时,对象模型默认为大小18(或xml中设置为默认值的任何值)。调整.Chart.ChartArea.Font属性会正确地导致子元素更改大小。问题是其他属性也在变化——当图表区域发生变化时,颜色和本地格式(粗体)会消失。此外,我不知道如何判断属性是否链接。