如何使用VBA在powerpoint中插入列

如何使用VBA在powerpoint中插入列,vba,powerpoint,Vba,Powerpoint,问题有点棘手,我在谷歌上搜索了一个VBA代码链接,它可以帮助我在单亲幻灯片中插入一个演示文稿的所有其他幻灯片的标题摘要。 代码运行正常,但是当标题幻灯片的数量超过30或50时,内容表父幻灯片无法保存整个标题名称,因为名称将被隐藏并超出幻灯片演示文稿的范围。 因此,我想确认是否有任何VBA代码可以通过目录幻灯片中的VBA将摘要名称的内容分发到三列?根据链接,您需要在宏的和处添加该代码: With summary.Shapes(2).TextFrame2 .Column.Number = 3

问题有点棘手,我在谷歌上搜索了一个VBA代码链接,它可以帮助我在单亲幻灯片中插入一个演示文稿的所有其他幻灯片的标题摘要。 代码运行正常,但是当标题幻灯片的数量超过30或50时,内容表父幻灯片无法保存整个标题名称,因为名称将被隐藏并超出幻灯片演示文稿的范围。
因此,我想确认是否有任何VBA代码可以通过目录幻灯片中的VBA将摘要名称的内容分发到三列?

根据链接,您需要在宏的和处添加该代码:

With summary.Shapes(2).TextFrame2
    .Column.Number = 3
End With
在摘要文本框中设置了3列。 请记住,您可能还需要设置字体大小,以便将文本保持在文本框内

附加信息:我看到的是,只要将更多文本放入摘要形状中,字体大小就会改变(减小)(
Shapes(2)
,在我的示例中)。然后可以跟踪字体大小,检查是否应该增加列数。以下是一个例子:

With summary.Shapes(2).TextFrame2
    If .TextRange.Font.Size < 20 Then
        'additionally check here if max approved column numbers is not exceeded.
        .Column.Number = .Column.Number + 1
    End If
End With
带summary.Shapes(2).TextFrame2
如果.TextRange.Font.Size小于20,则
'如果未超过最大批准列数,请在此处另外检查。
.Column.Number=.Column.Number+1
如果结束
以
下面是我完整的基本测试代码(可以为任何新的空演示文稿运行):

子测试_循环()
以幻灯片形式显示的摘要
Set summary=ActivePresentation.Slides.Add(1,ppLayoutText)
将文本设置为字符串
做
enterText=InputBox(“要插入形状的其他文本:”)
带summary.Shapes(2).TextFrame2
.TextRange.Text=.TextRange.Text&Chr(10)&enterText
如果.TextRange.Font.Size小于20,则
.Column.Number=.Column.Number+1
如果结束
以
输入文本“”时循环
端接头

Hi kazJaw,非常感谢这段优秀的代码,但是我想知道是否有代码可以根据标题名称的增加(即更多的幻灯片数量)在幻灯片中添加列,我怀疑使用幻灯片中的表格可以实现这一点,请给出您的想法?嗨,kazJaw,您编写的代码非常好,但是我想知道的是,我们输入的字体大小在数量上或多或少,并且增加了列,如果字体大小超过8,20,22,32,在这些参数下是否有可能?必须有一个数组来循环textframe2中的字体大小并增加列数,是否可以调整代码以实现这一点?我宁愿做一些测试,并使用附加的
ElseIf
条件扩展
If
语句。数组和循环可能会有帮助,但你有相当“静态”的情况。嗨,kazjaw,谢谢你的更新,但是我想知道下面的代码对summary.Shapes(2.TextFrame2.TextRange.Text=.TextRange.Text&Chr(10)有什么作用&enterText如果.TextRange.Font.Size<20那么.Column.Number=.Column.Number+1我在代码中尝试了上述代码新目录幻灯片中的标题字体大小为18,但是,它只会创建标题名超出幻灯片边距的两列。该部分会将新文本添加到summary TextShape,如果文本太大,它会自动调整字体大小。然后检查当前字体大小。如果当前字体大小小于20,则会向该文本形状添加新列。最好的选择是用F8运行代码并检查发生了什么。你不会明白的。
Sub test_loop()
    Dim summary As Slide
    Set summary = ActivePresentation.Slides.Add(1, ppLayoutText)

    Dim enterText as string
Do
    enterText = InputBox("Additional text to insert into Shape:")

With summary.Shapes(2).TextFrame2
    .TextRange.Text = .TextRange.Text & Chr(10) & enterText
    If .TextRange.Font.Size < 20 Then
        .Column.Number = .Column.Number + 1
    End If
End With

Loop While enterText <> ""
End Sub