VBA for Global PowerPointの文字間隔の正規化

Question

私は、1つのPowerPointドキュメント内のすべてのスライドの全文字間隔を一度に正規化するソリューションを考え出しています。私はすべての図形のためにそれを行うマクロを考え出したが、それはテーブルのテキストをスキップし続ける。。ただし、範囲にmsoTableを追加すると、スライドの処理が開始されますが、最初のテーブルにヒットすると、指定された値が範囲外であると主張する実行時エラーがすぐに返されます。

何が悪いと思いますか？それが簡単な修正であることを確かめてください。

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 

本当にありがとうございます。前もって感謝します！

Answer 1

PPTを自動化する最初のルール：絶対に必要な場合を除き、決して何も選択しないでください。 PPTを自動化する第2のルール：あなたはほとんど必要ありません。

これに応じてコードを変更しました。

そして、ほとんどの場合、何かを変更するには、セルごとにテーブルセルをステップインする必要があります。より多くの改造者。下記を参照してください。

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

ここに私が思いついたものがあります。これは1つのサブ内にあり、少しはっきりしているようです。

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