Question

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

我知道VBA中有自动调整大小功能，但我无法在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

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

Answer 1

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

根据一些网站的说法，TextFrame2是2007年以后的新财产。

您可以在msoAutoSizeTextToFitShape上尝试TextFrame2。

编辑：

我在家用电脑上试用了2010版本，看起来还不错。试试看。通过TextFrame

替换代码中的TextFrame2

Answer 2

您可以调整文字大小以确保其适合形状，也可以调整形状以适合文字大小。我的猜测是你想要前者，所以请注意这个：

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

PowerPoint形状导出恒定图像尺寸

2 个答案: