VBA für globale PowerPoint-Zeichenabstand Normalisierung

Question

Ich versuche, eine Lösung zu finden, um alle Zeichenabstand über alle Folien in einem einzigen PowerPoint-Dokument auf einmal zu normalisieren. Ich habe ein Makro, das es für alle Formen tun, aber es überspringt Text in Tabellen. Wenn ich jedoch msoTable in den Bereich einfüge, beginnt es mit der Verarbeitung der Folien, aber wenn es die erste Tabelle trifft, gibt es sofort einen Laufzeitfehler zurück, der behauptet, dass der angegebene Wert außerhalb des Bereichs liegt.

Irgendeine Idee, was ist falsch? Ziemlich sicher, es ist eine einfache Lösung.

Sub SpacingNormalization() 
On Error GoTo ErrMsg 
Dim shape As shape 
slideCount = ActivePresentation.Slides.Count 
For i = 1 To slideCount 
With ActivePresentation.Slides(i) 
.Select 
For Each shape In ActivePresentation.Slides(i).Shapes 
If shape.Type = msoPlaceholder Or shape.Type = msoTextBox Or shape.Type = msoAutoShape Or shape.Type = msoTable Then 
shape.Select 
ActiveWindow.Selection.ShapeRange.TextFrame2.TextRange.Font.Spacing = 0 
End If 
ErrMsg: 
Next 
End With 
Next 
MsgBox ("All segments have been normalized!") 
End Sub 

Jede Hilfe wird wirklich geschätzt. Danke im Voraus!

Answer 1

Erste Regel zur Automatisierung von PPT: Wählen Sie niemals etwas aus, es sei denn, Sie müssen es unbedingt tun. Zweite Regel der Automatisierung PPT: Sie müssen fast nie.

Ihren Code entsprechend geändert.

Und in den meisten Fällen müssen Sie eine Tabelle Zelle für Zelle durchlaufen, um alles zu ändern. Mehr Mods. Siehe unten:

Sub SpacingNormalization() 
On Error GoTo ErrMsg 
' It's unwise to use PPT keywords as variable names: 
' Dim shape As shape 
Dim oSh as Shape 
Dim oSl as Slide 

For each oSl in ActivePresentation.Slides 
For Each oSh In oSl.Shapes 

If oSh.Type = msoPlaceholder Or oSh.Type = msoTextBox Or oSh.Type = msoAutoShape Then 

oSh.TextFrame2.TextRange.Font.Spacing = 0 

Else 
If oSh.Type = msoTable then 
    Call ProcessTable(oSh.Table) 
end if ' Table 
End If ' Other types 
Next ' oSh 
Next ' oSl 


NormalExit: 
MsgBox ("All segments have been normalized!") 
Exit Sub 
ErrMsg: 
Resume Next 

End Sub 

Sub ProcessTable(oTbl As Table) 

    Dim Col As Long 
    Dim Row As Long 

    With oTbl 
     For Col = 1 To .Columns.Count 
      For Row = 1 To .Rows.Count 
       .Cell(Row, Col).Shape.TextFrame2.TextRange.Font.Spacing = 0 
      Next 
     Next 
    End With 

End Sub 

Answer 2

Hier ist der, den ich mir ausgedacht habe. Es ist in nur einem Sub und scheint ein bisschen einfacher zu sein:

Sub SpacingNormalization() 
     On Error GoTo Errmsg 
     Dim oshp As shape 
     Dim otbl As Table 
     Dim Rws As Integer 
     Dim Clms As Integer 
     Dim osld As Slide 
     For Each osld In ActivePresentation.Slides 
      For Each oshp In osld.Shapes 
       Select Case oshp.HasTable 
       Case Is = True 
        Set otbl = oshp.Table 
        For Rws = 1 To otbl.Rows.Count 
         For Clms = 1 To otbl.Columns.Count 
          otbl.Cell(Rws, Clms).shape.TextFrame2.TextRange.Font.Spacing = 0 
         Next Clms 
        Next Rws 
       Case Is = False 
        If oshp.HasTextFrame Then 
         If oshp.TextFrame.HasText Then 
          oshp.TextFrame2.TextRange.Font.Spacing = 0 
         End If 
        End If 
       End Select 
      Next oshp 
     Next osld 
     MsgBox ("All segments have been normalized!") 
     Exit Sub 
Errmsg: 
     MsgBox "Error" 
    End Sub