[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という数字を適当に変えて実行してみてください。

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