时间戳

首页 > 解决方案 > PowerPoint：快速文本操作

vba - PowerPoint：快速文本操作

问题描述

设置：我有一个包含 8 张相同幻灯片的 PowerPoint (16.0.4266.1001) 演示文稿。每张幻灯片都包含许多包含文本的矩形1（请参阅https://imgur.com/a/7AQcXFR）。每个矩形的粗体都是随机设置的（通过宏，如果重要的话：https ://pastebin.com/embed_js/6qcVa1xj ）。

目标：我想找到最快将所有矩形的粗体设置为特定值的方法。为了进行测试，我有两个宏 (DoItSlow和DoItFast) 以两种不同的方式将所有内容设置为粗体。

DoItSlow逐个形状遍历形状并设置每个形状的粗体。

Sub DoItSlow()
    On Error Resume Next
    For Each sld In ActivePresentation.Slides
            For Each shp In sld.Shapes
                shp.TextFrame2.TextRange.Font.Bold = msoTrue
            Next shp
    Next sld
End Sub

DoItFast选择每张幻灯片的所有形状，并立即应用粗体。

Sub DoItFast()
    On Error Resume Next
    For Each sld In ActivePresentation.Slides
            sld.Shapes.Range.TextFrame2.TextRange.Font.Bold = msoTrue
    Next sld
End Sub

两个宏都可以实现我想要的，但DoItFast需要大约 5 秒，而DoItSlow需要大约 20 秒：因此显然批处理比一个一个处理要快得多。我可以在保持一对一方法的同时达到相同的速度吗？

背景：最后，我不想将所有内容都设置为粗体，而是根据每个矩形来决定，而且我更希望在不触及选择的情况下尽可能地将工作保持在本地。

标签： vbaperformancepowerpoint

解决方案

增加使加粗代码更快的解决方案是首先创建一个要加粗的形状数组，然后使用上述数组立即进行加粗。

请测试以下两种加粗一半形状的方法：

  1. 每次迭代将它们中的每一个加粗：
Sub testBoldByIteration()
    Dim sl As Slide, shp As Shape, i As Long, t
    Set sl = ActivePresentation.Slides(1)
    sl.Shapes.Range.TextFrame2.TextRange.Font.Bold = msoFalse
     t = Timer
    For Each shp In sl.Shapes
        i = i + 1
        If i Mod 2 = 0 Then shp.TextFrame.TextRange.Font.Bold = msoTrue
    Next
    Debug.Print Timer - t
End Sub
  1. 将要加粗的形状放在一个数组中，并在最后一次加粗：
Sub testBoldByArray()
    Dim sl As Slide, arrSh() As Long, i As Long, k As Long, t
    Set sl = ActivePresentation.Slides(1)
    sl.Shapes.Range.TextFrame2.TextRange.Font.Bold = msoFalse
    ReDim arrSh(sl.Shapes.Count)
    t = Timer
    For i = 1 To sl.Shapes.Count
        If i Mod 2 = 0 Then arrSh(k) = i: k = k + 1
    Next
    ReDim Preserve arrSh(k - 1)
     sl.Shapes.Range(arrSh).TextFrame2.TextRange.Font.Bold = msoTrue
     Debug.Print Timer - t
End Sub

对于大量的形状，差异应该是巨大的......

推荐阅读