Question

我在VBA Excel中编写查找/替换。我从谷歌中挑选了这段代码。当我通过将PPT粘贴为宏来运行此代码时，它运行正常，但它不在Excel上运行（当我将此代码粘贴到Excel作为MAcro时）VBA for PPT。实际上我有一个在VBA Excel上制作的应用程序。我通过我的应用程序打开一个PPT文件，执行查找和替换操作。

Dim FindWhat As String
Dim ReplaceWith As String
Dim oShp As PowerPoint.Shape
Dim oRng As TextRange
Dim oPres As Presentation
Dim oSld As Slide
Dim pptSlide As PowerPoint.Slide

public sub ReplaceInPPT()
FindWhat = searchtext
ReplaceWith = valuetext
    For Each oPres In Application.Presentations '<- Throws "Object doesn't support this property or method"
        For Each pptSlide In oPres.Slides
                On Error Resume Next

                For Each oShp In oSld.Shapes
                    Call ReplaceTextPPT(oShp, FindWhat, ReplaceWith)
                Next oShp
        Next pptSlide
    Next oPres
End Sub


Public Sub ReplaceTextPPT(oShp As Object, FindString As String, ReplaceString As String)
On Error Resume Next
Select Case oShp.Type

Case 19
        'msoTable
    For iRows = 1 To oShp.Table.Rows.count
        For icol = 1 To _
        oShp.Table.Rows(iRows).Cells.count
            Set oTxtRng = oShp.Table.Rows(iRows).Cells(icol).Shape.TextFrame.TextRange
            Set oTmpRng = oTxtRng.Replace(FindWhat:=FindString, _
                         Replacewhat:=ReplaceString, WholeWords:=True)
Do While Not oTmpRng Is Nothing
Set oTmpRng = oTxtRng.Replace(FindWhat:=FindString, _
              Replacewhat:=ReplaceString, After:=oTmpRng.Start + oTmpRng.Length, WholeWords:=True)
Loop
        Next
    Next
Case msoGroup 'Groups may contain shapes with text, so look within it
    For i = 1 To oShp.GroupItems.count
        Call ReplaceText(oShp.GroupItems(i), FindString, ReplaceString)
    Next i
Case 21 ' msoDiagram
    For i = 1 To oShp.Diagram.Nodes.count
        Call ReplaceText(oShp.Diagram.Nodes(i).TextShape, FindString, ReplaceString)

        Next i
Case Else
    If oShp.HasTextFrame Then
        If oShp.TextFrame.HasText Then
            Set oTxtRng = oShp.TextFrame.TextRange
        Set oTmpRng = oTxtRng.Replace(FindWhat:=FindString, _ 
                     Replacewhat:=ReplaceString, WholeWords:=True)
            Do While Not oTmpRng Is Nothing
                Set oTmpRng = oTxtRng.Replace(FindWhat:=FindString, _
                              Replacewhat:=ReplaceString, _
                        After:=(oTmpRng.Start - 1) + oTmpRng.Length, WholeWords:=True)
            Loop
       End If
    End If
End Select
End Sub

Answer 1

此代码仅适用于PowerPoint，因为此代码：

For Each oPres In Application.Presentations '<- Throws "Object doesn't support this property or method"
    For Each pptSlide In oPres.Slides
            On Error Resume Next

            For Each oShp In oSld.Shapes
                Call ReplaceTextPPT(oShp, FindWhat, ReplaceWith)
            Next oShp
    Next pptSlide
Next oPres

遍历当前powerpoint-application的所有演示文稿和幻灯片。 Excel没有演示文稿或幻灯片，因此无法使用。

Answer 2

我删除了那行代码，因为这只适用于PowerPoint，因为@Manu说。现在，这对我来说很好。

 For Each pptSlide In pptPres.Slides
     For Each oShp In pptSlide.Shapes
         Call ReplaceTextPPT(oShp, FindWhat, ReplaceWith)
     Next oShp
Next pptSlide

感谢@simoco，@ mehow和@Manu为您提供帮助我的时间和精力:-)。

运行时错误'438'对象不支持此属性或方法

2 个答案: