Question

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

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

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

时

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

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

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

任何人都可以告诉我如何在保持用户设置样式的同时修改文本。

感谢。

如果有用，请使用Office 2010。

Answer 1

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

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

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

$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()

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

3 个答案: