1

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

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

然后，我将我的标签替换为请求的值。但是，当我设置做

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

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

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

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

谢谢。

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

4

3 回答 3

4

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
于 2015-12-17T01:04:47.620 回答
0

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

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

希望这可以帮助！

于 2014-11-13T16:22:49.050 回答
0

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

$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()
于 2016-09-17T20:50:20.517 回答