PowerPoint Shape Export Constant Image Dimensions

Question

Я пытаюсь экспортировать PPT Shape в файл изображения, однако PowerPoint переопределяет форму до длины текста.

Я знаю, что есть функция Autosize в VBA, однако я не могу получить функцию msoAutoSizeTextToFitShape работы в PowerPoint 2013.

Мой код выглядит следующим образом

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

Вы можете либо настроить размер текста, чтобы убедиться, что она вписывается в форме или изменить форму, чтобы соответствовать размеру текста. Я предполагаю, что вам нужно бывшее, так что сделайте снимок с этим:

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 

Answer 2

У меня есть версия 2003, установленная на моем текущем ПК, так что НЕ ИСПЫТАНО.

Согласно некоторым веб-сайтам, TextFrame2 - это новое свойство с 2007 года.

Вы можете попробовать msoAutoSizeTextToFitShape вместо TextFrame2.

EDIT:

Я попробовал это в моем домашнем ПК с версией 2010 года, и выглядит хорошо. Попробуйте. Заменить TextFrame в вашем коде TextFrame2