如何在不改变样式的情况下通过 Excel VBA 修改 Powerpoint 中的文本

How to modify text in Powerpoint via Excel VBA without changing style

提问by user1412028

I am trying to replace a set of tags in the text of a powerpoint slide from Excel using VBA. I can get the slide text as follows:

我正在尝试使用 VBA 替换 Excel 幻灯片文本中的一组标签。我可以按如下方式获取幻灯片文本：

Dim txt as String
txt = pptSlide.Shapes(jj).TextFrame.TextRange.Characters.text

I then run through replacing my tags with the requested values. However when I set do

然后我用请求的值替换我的标签。但是，当我设置时

pptSlide.Shapes(jj).TextFrame.TextRange.Characters.text = txt

Problem: All the formatting which the user has set up in the text box is lost.

问题：用户在文本框中设置的所有格式都丢失了。

Background: The shape object is msoPlaceHolder and contains a range of text styles including bullet points with tags which should be replaced with numbers for instance. The VBA should be unaware of this formatting and need only concern itself with the text replacement.

背景：形状对象是 msoPlaceHolder 并包含一系列文本样式，包括带有标签的项目符号，例如应该用数字替换。VBA 应该不知道这种格式，只需要关注文本替换。

Can anyone tell me on how to modify the text while keeping the style set up by the user.

谁能告诉我如何在保持用户设置的样式的同时修改文本。

Thanks.

谢谢。

Am using Office 2010 if that is helpful.

如果有帮助，我正在使用 Office 2010。

采纳答案by E. Krause

While what Steve Rindsberg said is true I think I have come up with a decent workaround. It is by no means pretty but it gets the job done without sacrificing the formatting. It uses Find functions and Error Controlling for any text box that doesn't have the variable you are looking to change out.

虽然 Steve Rindsberg 说的是真的，但我想我已经想出了一个不错的解决方法。它绝不是漂亮的，但它可以在不牺牲格式的情况下完成工作。它对没有您要更改的变量的任何文本框使用查找函数和错误控制。

i = 1

Set oPs = oPa.ActivePresentation.Slides(oPa.ActivePresentation.Slides.Count)

j = 1

Do Until i > oPa.ActivePresentation.Slides.Count

oPa.ActivePresentation.Slides(i).Select

Do Until j > oPa.ActivePresentation.Slides(i).Shapes.Count

    If oPa.ActivePresentation.Slides(i).Shapes(j).HasTextFrame Then
        If oPa.ActivePresentation.Slides(i).Shapes(j).TextFrame.HasText Then

            On Error GoTo Err1

            If oPa.ActivePresentation.Slides(i).Shapes(j).TextFrame.TextRange.Find("[specific search term]") = "[specific search term]" Then
                m = oPa.ActivePresentation.Slides(i).Shapes(j).TextFrame.TextRange.Find("[specific search term]").Characters.Start
                oPa.ActivePresentation.Slides(i).Shapes(j).TextFrame.TextRange.Characters(m).InsertBefore ([replace term])
                oPa.ActivePresentation.Slides(i).Shapes(j).TextFrame.TextRange.Find("[specific search term]").Delete
ExitHere:
            End If
        End If
    End If

    j = j + 1

Loop

j = 1

i = i + 1

Loop

Exit Sub

Err1:

Resume ExitHere

End Sub

Hope this helps!

希望这可以帮助！

回答by PJ_in_FL

The solution by Krause is close but the FIND method returns a TextRange object that has to be checked. Here is a complete subroutine that replaces FROM-string with TO-string in an entire presentation, and DOESN'T mess up the formatting!

Krause 的解决方案很接近，但 FIND 方法返回一个必须检查的 TextRange 对象。这是一个完整的子程序，它在整个演示文稿中用 TO-string 替换 FROM-string，并且不会弄乱格式！

Sub Replace_in_Shapes_and_Tables(pPPTFile As Presentation, sFromStr As String, sToStr As String)
    Dim sld         As Slide
    Dim shp         As Shape
    Dim i           As Long
    Dim j           As Long
    Dim m           As Long
    Dim trFoundText As TextRange

    On Error GoTo Replace_in_Shapes_and_Tables_Error

    For Each sld In pPPTFile.Slides
        For Each shp In sld.Shapes

            If shp.HasTextFrame Then
                If shp.TextFrame.HasText Then                   ' only perform action on shape if it contains the target string
                    Set trFoundText = shp.TextFrame.TextRange.Find(sFromStr)
                    If Not (trFoundText Is Nothing) Then
                        m = shp.TextFrame.TextRange.Find(sFromStr).Characters.Start
                        shp.TextFrame.TextRange.Characters(m).InsertBefore (sToStr)
                        shp.TextFrame.TextRange.Find(sFromStr).Delete
                    End If
                End If
            End If

            If shp.HasTable Then
                For i = 1 To shp.Table.Rows.Count
                    For j = 1 To shp.Table.Columns.Count

                        Set trFoundText = shp.Table.Rows.Item(i).Cells(j).Shape.TextFrame.TextRange.Find(sFromStr)
                        If Not (trFoundText Is Nothing) Then
                            m = shp.Table.Rows.Item(i).Cells(j).Shape.TextFrame.TextRange.Find(sFromStr).Characters.Start
                            shp.Table.Rows.Item(i).Cells(j).Shape.TextFrame.TextRange.Characters(m).InsertBefore (sToStr)
                            shp.Table.Rows.Item(i).Cells(j).Shape.TextFrame.TextRange.Find(sFromStr).Delete
                        End If

                    Next j
                Next i
            End If

        Next shp
    Next sld


    For Each shp In pPPTFile.SlideMaster.Shapes
        If shp.HasTextFrame Then
            If shp.TextFrame.HasText Then
                Set trFoundText = shp.TextFrame.TextRange.Find(sFromStr)
                If Not (trFoundText Is Nothing) Then
                    m = shp.TextFrame.TextRange.Find(sFromStr).Characters.Start
                    shp.TextFrame.TextRange.Characters(m).InsertBefore (sToStr)
                    shp.TextFrame.TextRange.Find(sFromStr).Delete
                End If

            End If
        End If

        If shp.HasTable Then
            For i = 1 To shp.Table.Rows.Count
                For j = 1 To shp.Table.Columns.Count
                    Set trFoundText = shp.Table.Rows.Item(i).Cells(j).Shape.TextFrame.TextRange.Find(sFromStr)
                    If Not (trFoundText Is Nothing) Then
                        m = shp.Table.Rows.Item(i).Cells(j).Shape.TextFrame.TextRange.Find(sFromStr).Characters.Start
                        shp.Table.Rows.Item(i).Cells(j).Shape.TextFrame.TextRange.Characters(m).InsertBefore (sToStr)
                        shp.Table.Rows.Item(i).Cells(j).Shape.TextFrame.TextRange.Find(sFromStr).Delete
                    End If

                Next j
            Next i
        End If
    Next shp

   On Error GoTo 0
   Exit Sub

Replace_in_Shapes_and_Tables_Error:

    MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure Replace_in_Shapes_and_Tables of Module modA_Code"
    Resume

End Sub

回答by Justin Henderson

I found the solution using the code below. It edits the notes by replacing "string to replace" with "new string". This example is not iterative and will only replace the first occurrence but it should be fairly easy to make it iterative.

我使用下面的代码找到了解决方案。它通过用“新字符串”替换“要替换的字符串”来编辑注释。这个例子不是迭代的，只会替换第一次出现，但它应该很容易迭代。

$PowerpointFile = "C:\Users\username\Documents\test.pptx"
$Powerpoint = New-Object -ComObject powerpoint.application
$ppt = $Powerpoint.presentations.open($PowerpointFile, 2, $True, $False)
$ppt.Slides[3].Shapes[2].TextFrame.TextRange.Text
$ppt.Slides[3].NotesPage.Shapes[2].TextFrame.TextRange.Text
foreach($slide in $ppt.slides){
    $TextRange = $slide.NotesPage.Shapes[2].TextFrame.TextRange

    $find = $TextRange.Find('string to replace').Start
    $TextRange.Find('string to replace').Delete()
    $TextRange.Characters($find).InsertBefore('new string')

    $TextRange.Text
}

$ppt.SaveAs("C:\Users\username\Documents\test2.pptx")
$Powerpoint.Quit()