Power Point Macro: Run ошибка времени 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 об ошибке для этого кода.

Также этот код заменяет только первое вхождение определенных слов типа "i.e." и "eg :, но я хочу заменить все вхождения.

Answer 1

Причина ошибки в том, что вы пытаетесь ссылаться на элемент 21 в массиве DestinationList, и его нет, потому что вам не хватает соответствующего аргумента для «pm» Я добавил проверку ошибок для этого, скорректировал строку Dim для I, K, 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