Power Point宏：运行时错误9

Question

此代码是查找并替换文本列表以进行质量检查

sub FindAndReplace()
 Dim Pres As Presentation
 Dim sld As Slide
 Dim shp As Shape

 For Each Pres In Application.Presentations
      For Each sld In Pres.Slides
         For Each shp In sld.Shapes
             Call checklist(shp)
         Next shp
     Next sld
 Next Pres
 MsgBox "Completed Succesfully!"
 End Sub

Sub checklist(shp As Object)

    Dim txtRng As TextRange
    Dim rngFound As TextRange
    Dim I, K, X As Long
    Dim iRows As Integer
    Dim iCols As Integer
    Dim TargetList, DestinationList

    TargetList = Array("        ", "       ", "      ", "     ", "    ", "   ", "  ", " / ", "i.e. ", "e.g. ", "/ ", " /", " :", " ;", " .", " ,", " - ", "resume", "a.m.", "p.m.", ":00")
    DestinationList = Array(" ", " ", " ", " ", " ", " ", " ", "/", "i.e., ", "e.g., ", "/", "/", ":", ";", ".", ",", " – ", "résumé", "am", "")


       With shp

       If shp.HasTable Then
       For iRows = 1 To shp.Table.Rows.Count
                    For iCols = 1 To shp.Table.Rows(iRows).Cells.Count
                        Set txtRng = shp.Table.Rows(iRows).Cells(iCols).Shape.TextFrame.TextRange
                               For I = 0 To UBound(TargetList)
                               Set rngFound = txtRng.Replace(TargetList(I), DestinationList(I))
                               Do While Not rngFound Is Nothing
                               Set rngFound = txtRng.Replace(TargetList(I), DestinationList(I), After:=rngFound.Start + rngFound.Length, wholewords:=True)
                               Loop
                               Next
                        Next
                Next
       End If

     End With


           Select Case shp.Type


            Case msoGroup
                For X = 1 To shp.GroupItems.Count
                    Call checklist(shp.GroupItems(X))
                Next X

            Case 21
                For X = 1 To shp.Diagram.Nodes.Count
                    Call checklist(shp.GroupItems(X))
                Next X

            Case Else

                 If shp.HasTextFrame Then
                           If shp.TextFrame.HasText Then
                               Set txtRng = shp.TextFrame.TextRange
                               For I = 0 To UBound(TargetList)
                               Set rngFound = txtRng.Replace(TargetList(I), DestinationList(I))
                               Do While Not rngFound Is Nothing
                               Set rngFound = txtRng.Replace(TargetList(I), DestinationList(I), After:=rngFound.Start + rngFound.Length, wholewords:=True)
                               Loop
                               Next
                           End If
                       End If

            End Select


End Sub

我收到此代码的运行时9错误。

同样，此代码仅替换某些单词（例如“ ie”和“ eg：”）的首次出现，但我想替换所有出现的单词。

Answer 1

错误的原因是您尝试引用DestinationList数组中的第21个项目，并且该项目不存在，因为您缺少“ pm”的相应参数，为此我添加了错误检查，并更正了I，K的Dim行，X，并在循环数组时将0更改为LBound，因为如果基数不为0，也会引起问题。 更正的代码：

Option Explicit

Private ArrayError As Boolean

Sub FindAndReplace()
 Dim Pres As Presentation
 Dim sld As Slide
 Dim shp As Shape

 ArrayError = False
 For Each Pres In Application.Presentations
      For Each sld In Pres.Slides
         For Each shp In sld.Shapes
             If Not ArrayError Then checklist shp
         Next shp
     Next sld
 Next Pres
 If Not ArrayError Then MsgBox "Completed Succesfully!"
 End Sub

Sub checklist(shp As Object)

    Dim txtRng As TextRange
    Dim rngFound As TextRange
    Dim I As Long, K As Long, X As Long
    Dim iRows As Integer
    Dim iCols As Integer
    Dim TargetList, DestinationList

    TargetList = Array("        ", "       ", "      ", "     ", "    ", "   ", "  ", " / ", "i.e. ", "e.g. ", "/ ", " /", " :", " ;", " .", " ,", " - ", "resume", "a.m.", "p.m.", ":00")
    DestinationList = Array(" ", " ", " ", " ", " ", " ", " ", "/", "i.e., ", "e.g., ", "/", "/", ":", ";", ".", ",", " ? ", "résumé", "am", "pm", "")

    If Not UBound(TargetList) = UBound(DestinationList) Then
      MsgBox "Search and Replace arrary do not have the same number of arguments.", vbCritical + vbOKOnly, "Arrays Don't Match"
      ArrayError = True
      Exit Sub
    End If

       With shp

       If shp.HasTable Then
       For iRows = 1 To shp.Table.Rows.Count
                    For iCols = 1 To shp.Table.Rows(iRows).Cells.Count
                        Set txtRng = shp.Table.Rows(iRows).Cells(iCols).Shape.TextFrame.TextRange
                               For I = LBound(TargetList) To UBound(TargetList)
                               Set rngFound = txtRng.Replace(TargetList(I), DestinationList(I))
                               Do While Not rngFound Is Nothing
                               Set rngFound = txtRng.Replace(TargetList(I), DestinationList(I), After:=rngFound.Start + rngFound.Length, wholewords:=True)
                               Loop
                               Next
                        Next
                Next
       End If

     End With


           Select Case shp.Type


            Case msoGroup
                For X = 1 To shp.GroupItems.Count
                    Call checklist(shp.GroupItems(X))
                Next X

            Case 21
                For X = 1 To shp.Diagram.Nodes.Count
                    Call checklist(shp.GroupItems(X))
                Next X

            Case Else

                 If shp.HasTextFrame Then
                           If shp.TextFrame.HasText Then
                               Set txtRng = shp.TextFrame.TextRange
                               For I = LBound(TargetList) To UBound(TargetList)
                               Set rngFound = txtRng.Replace(TargetList(I), DestinationList(I))
                               Do While Not rngFound Is Nothing
                               Set rngFound = txtRng.Replace(TargetList(I), DestinationList(I), After:=rngFound.Start + rngFound.Length, wholewords:=True)
                               Loop
                               Next
                           End If
                       End If

            End Select


End Sub