电源点宏:运行时错误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错误的这段代码。

此外，此代码仅替换某些单词的第一次出现，如“即”。和“，但我想要替换所有的事件。

Answer 1

错误的原因是您试图在DestinationList数组中引用项21，但它不存在，因为您缺少了对应的“p.m”参数。为此，我添加了错误检查，在循环数组时更正了I、K、X的Dim行，并将其更改为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