如何通过Excel VBA在Powerpoint中修改文本而不更改样式

Question

我正试图使用VBA替换Excel中powerpoint幻灯片文本中的一组标记。我可以获得如下幻灯片文本：

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

然后，我用请求的值替换标记。然而，当我设置做

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

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

背景：shape对象是msoPlaceHolder，包含一系列文本样式，包括带标记的项目符号，例如，这些标记应替换为数字。VBA应该不知道这种格式，只需要关心文本替换。

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

谢谢。

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

Answer 1

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

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

Answer 2

虽然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

希望这能有所帮助！

Answer 3

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

$PowerpointFile = "C:UsersusernameDocumentstest.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:UsersusernameDocumentstest2.pptx")
$Powerpoint.Quit()