[PowerPoint VBA]パワーポイントで、テキストボックスのサイズを自動調整する   

PowerPoint VBAの使い方

パワーポイントで、文字がテキストボックスからはみ出しているときに、強制的にフォントサイズを小さくしてボックス内に収めたいことがあります。 上の図の場合、文字がはみ出して２段になってしまっています。(自動折り返しの場合）
これを１段に収めるには、フォントサイズを小さくさいないといけません。
対象ファイルがいっぱいある場合は、手作業でやると時間がかかって大変ですよね。

そんなときこそVBAで自動化しましょう。

Sub Macro1()
    
    With ActivePresentation.Slides(1).Shapes("Text Box 1").TextFrame.TextRange
    
            Do While .BoundHeight > 20  ' テキストボックスの高さが20以上の場合は２段だと判断
             .Font.Size = .Font.Size - 1
            Loop

      End With

End Sub

shapes("Text Box1")の部分は、ファイルによって違いますので、「マクロの記録」機能を使って調べましょう。

さて、このコードを実行すると↓こうなります。

ちゃんと１段に収まってくれました。

テキストボックスの横方向にはみ出す場合

テキストボックスでを文字を折り返す設定にしていない場合は、横にはみ出します。



この場合は、こう書きます。↓

Sub Macro1()
    
    With ActivePresentation.Slides(1).Shapes("Text Box 1").TextFrame.TextRange
    
            Do While .BoundHeight > 500  ' 横幅500ポイントに収まるまで、フォントを縮小
             .Font.Size = .Font.Size - 1
            Loop

      End With

End Sub

500という数字を適当に変えて実行してみてください。

ちゃんと収まってくれました。