PowerPoint 形状导出恒定图像尺寸答案

【问题标题】：PowerPoint Shape Export Constant Image DimensionsPowerPoint 形状导出恒定图像尺寸
【发布时间】：2013-10-02 03:36:22
【问题描述】：

我正在尝试将 PPT 形状导出到图像文件中，但是 PowerPoint 正在根据文本长度重新调整形状的大小。

我知道 VBA 中有 Autosize 功能，但是我无法在 PowerPoint 2013 中使用 msoAutoSizeTextToFitShape 功能。

我的代码如下

Sub RunMe()
    Dim MyShape As Shape
    Dim i As Integer
    Dim S(0 To 2) As String

    Set MyShape = ActivePresentation.Slides(1).Shapes.AddShape(msoShapeRectangle, 50, 50, 100, 40)
    S(0) = "short text"
    S(1) = "Medium length text"
    S(2) = "Really Really Long and descriptive Text"
        For i = 0 To 2
            With MyShape
                '.TextFrame.AutoSize = PowerPoint.ppAutoSizeMixed
                .TextFrame.TextRange.Text = S(i)
                .Export "C:\temp\" & "\" & S(i) & ".png", ppShapeFormatPNG
            End With
        Next i
End Sub

如您所见，生成的图像尺寸不同。有没有办法创建相同大小的图像？

【问题讨论】：

标签： vba powerpoint shapes

【解决方案1】：

您可以调整文字大小以确保它适合形状，也可以调整形状以适合文字大小。我猜你会想要前者，所以试试这个：

Sub RunMe()
    Dim MyShape As Shape
    Dim i As Integer
    Dim S(0 To 2) As String
    Dim sngOriginalSize As Single

    Set MyShape = ActivePresentation.Slides(1).Shapes.AddShape(msoShapeRectangle, 50, 50, 100, 40)
    S(0) = "short text"
    S(1) = "Medium length text"
    S(2) = "Really Really Long and descriptive Text"
        For i = 0 To 2
            With MyShape
                .TextFrame.TextRange.Text = S(i)

                ' store original text size
                sngOriginalSize = .TextFrame.TextRange.Font.Size

                ' decrement font size until the text fits
                ' within the shape:
                Do While .TextFrame.TextRange.BoundHeight > MyShape.Height
                    .TextFrame.TextRange.Font.Size = .TextFrame.TextRange.Font.Size - 1
                Loop

                .Export "C:\temp\" & "\" & S(i) & ".png", ppShapeFormatPNG

                ' reset the text to original size
                .TextFrame.TextRange.Font.Size = sngOriginalSize
            End With
        Next i
End Sub

【讨论】：

【解决方案2】：

我在当前 PC 上安装了 2003 版，因此以下内容未测试。

根据一些网站，TextFrame2 是 2007 年以后的新属性。

您可以在TextFrame2 上尝试msoAutoSizeTextToFitShape。

编辑：

我在我的家用电脑上用 2010 版试过这个，看起来还不错。试一试。将代码中的TextFrame 替换为TextFrame2

【讨论】：