触发PowerPoint文本自动操作行为，而无需显示应用程序窗口

Question

我正在尝试自动生成报告作为PowerPoint演示文稿。当前无法正常工作的功能是PowerPoint的自动文本自动拟合，当文本溢出形状的边界时会发生。

如果设置了形状，以使文本必须拟合形状（默认为默认值），则随着添加文本，自动降低了形状中所有文本的字体大小。这种行为显然只有在可见应用时才激活。这也许是因为实际呈现文本的行为是指向PowerPoint介绍溢出的原因，然后触发字体缩小尺寸。

当我隐藏使用应用程序窗口的演示文稿时，不会发生此自动拟合。如果我然后打开演示文稿并以任何方式修改文本框，则字体会收缩。隐藏然后重新展示幻灯片也成功更新了字体。在隐藏演示文稿时，从VBA执行相同的操作不会触发字体大小更新。

有人知道如何在不显示应用程序窗口的情况下触发PowerPoint的字体自动拟合行为吗？

以下是证明问题的最小示例：

Sub new_presentation()
    Dim pres As Presentation
    Dim sl As Slide
    Dim textbox As Shape
    Dim tf As TextFrame
    Dim tr As TextRange
    Set pres = Application.Presentations.Add(WithWindow:=msoFalse)
'    For Each Layout In pres.SlideMaster.CustomLayouts
'        Debug.Print Layout.Name
'    Next
    Set sl = pres.Slides.AddSlide(1, pres.SlideMaster.CustomLayouts.Item(2))
    Set textbox = sl.Shapes.Placeholders(2)
    Set tf = textbox.TextFrame
    Set tr = tf.TextRange
    tr.Text = "Some text" & vbCrLf & _
                "More Text" & vbCrLf & _
                "More Text" & vbCrLf & _
                "More Text" & vbCrLf & _
                "More Text" & vbCrLf & _
                "More Text" & vbCrLf & _
                "More Text" & vbCrLf & _
                "More Text" & vbCrLf & _
                "More Text" & vbCrLf & _
                "More Text" & vbCrLf & _
                "More Text" & vbCrLf & _
                "More Text" & vbCrLf & _
                "More Text" & vbCrLf & _
                "More Text"
    pres.SaveAs FileName:="D:DocumentsPythonpowerpointvba_demo.pptx"
    pres.Close
End Sub

记住要更新SaveAs文件名作为系统上有效的文件夹。

我在Windows 7上使用PowerPoint2013。这种行为也可能存在于其他版本中。

我实际上是使用python-pptx和com的组合使用python来做的，但是VBA示例执行相同的行为，我认为这个示例比其他编程语言中的同一件事要比同一件事要容易得多。

编辑：这是指向生成的文件的链接，没有显示PowerPoint应用程序窗口。编辑文本，隐藏幻灯片，添加幻灯片等，将迫使更新会触发自动拟合行为。示例文件

这是一个带有宏的PowerPoint文件，该文件创建了自动生成文件。宏文件

下面用作手动缩放文本的加强代码。

编辑：作为妥协的解决方法，以下代码将字体大小降低到文本合适为止……因此它是手工编码的自动拟合。我添加了一些缩进级别，以验证具有不同字体大小的级别都以相对方式扩展。我仍然想知道是否有一种方法可以让PowerPoint的自动Fotot做这件事，所以我将问题打开。

Sub new_presentation()
    Dim pres As Presentation
    Dim sl As Slide
    Dim textbox As Shape
    Dim tf As TextFrame
    Dim tr As TextRange
    Set pres = Application.Presentations.Add(WithWindow:=msoFalse)
'    For Each Layout In pres.SlideMaster.CustomLayouts
'        Debug.Print Layout.Name
'    Next
    Set sl = pres.Slides.AddSlide(1, pres.SlideMaster.CustomLayouts.Item(2))
    Set textbox = sl.Shapes.Placeholders(2)
    Set tf = textbox.TextFrame
    Set tr = tf.TextRange
    tr.Text = "Row 1" & vbCrLf & _
                "Row 2" & vbCrLf & _
                "Row 3" & vbCrLf & _
                "Row 4" & vbCrLf & _
                "Row 5" & vbCrLf & _
                "Row 6" & vbCrLf & _
                "Row 7" & vbCrLf & _
                "Row 8" & vbCrLf & _
                "Row 9" & vbCrLf & _
                "Row 10" & vbCrLf & _
                "Row 11" & vbCrLf & _
                "Row 12" & vbCrLf & _
                "Row 13" & vbCrLf & _
                "Row 14"
    ' Indent some rows out to levels 2 and 3
    tr.Paragraphs(2, 1).IndentLevel = 2
    tr.Paragraphs(3, 3).IndentLevel = 3
    tr.Paragraphs(6, 1).IndentLevel = 2
    tr.Paragraphs(7, 3).IndentLevel = 3
    tr.Paragraphs(10, 1).IndentLevel = 2
    tr.Paragraphs(11, 3).IndentLevel = 3
    ' Get the max height for the text to fit in the box...
    h_max = textbox.Height - tf.MarginTop - tf.MarginBottom
    overflow = tr.BoundHeight - h_max
    iLoop = 0
    While overflow > 0 And iLoop < 20
        prev_overflow = overflow
        For i = 1 To tr.Paragraphs.Count
            Set p = tr.Paragraphs(i, 1)
            before = p.Font.Size
            after = Round(before * 0.9, 0)
            p.Font.Size = after
        Next
        overflow = tr.BoundHeight - h_max
        iLoop = iLoop + 1
        Debug.Print "Iteration: " & iLoop & " Overflow: " & overflow
    Wend
    pres.SaveAs FileName:="D:DocumentsPythonpowerpointvba_demo.pptx"
    pres.Close
End Sub

Answer 1

我通过将文本框添加到空幻灯片中进行了非常简单的测试。我设置以下属性：

.TextFrame2.AutoSize = msoAutoSizeTextToFitShape ' Shrink text on overflow
.TextFrame.WordWrap ' Wrap text in shape

i然后最小化窗口，创建了一个新的演示文稿（以便成为活动窗口），然后通过VBE即时窗口编程为第一个演示文稿中的形状添加了一条长文本：

演示文稿（1）.Slides（1）。形状（1）.TextFrame.Textrange.Text =" Lorem Ipsum dolor sit Amet，Consectetuer dipipercisingElit。MaecenasPorttitor congueconsa。Fusceposuere posuere posuere posuere，Magna Seduinar sedulinar ultories，purus lectus lectus purus lectus lectus lectus us lectusMalesuada Libero，坐在Amet Commoto Magna Eros Quis urna。"

将鼠标移到Windows任务栏中的缩略图的PowerPoint堆栈时，我已经可以看到文本大小已减少。因此，似乎自动拟合功能对我有用。

更新：

因此，即使您将PRES设置为具有可见（最小化或其他）窗口，因此似乎没有应用自动化功能，因为PRES在PowerPoint有机会更新它之前已关闭。我测试了一个理论，即PowerPoint不会更新视图，直到代码停止通过更改代码的一行：

：

Set pres = Application.Presentations.Add(WithWindow:=msoFalse)

然后，我在您的Saveas线上设置了一个断点。当中断代码时，您会看到自动化起作用，并且何时自由运行时，自动化行动不起作用。如果我用可见的窗口运行，并且最后两行评论出来，也会发生同样的情况。因此，看来PowerPoint在代码运行时无法刷新内容，并且/或当代码完成时正在查看窗口。我尝试了各种doevents and Sleep（使用Winapi）的组合，但没有任何效果。我还指出，使用睡眠时，窗口出现幻灯片，但没有内容（好像PowerPoint都在等待直到代码执行完成，然后再刷新窗口）。因此，我留下来，除非您允许您的代码在关闭文件之前完成，否则这将行不通。