PowerPoint VBA 行間と字間を指定値で広げる詰めるマクロ

PowerPointを使い、テキストの行間と字間を指定値で自由に広げたり詰めたりできるマクロをご紹介します。行間は「段落後」と「行間の倍数」で設定します。

マクロを使えば、Illustratorの文字パネルを操作するように素早く調整できます。

パワポの行間の微調整は時間がかかる

PowerPointでテキストの行間を調整するときは、「ホーム」タブ →「段落」グループ右下の矢印をクリックして「段落」ダイアログボックスを開きます。

続いて、「段落」ダイアログボックスの「段落後」や「行間の倍数」の値を調整します。「段落前」「段落後」を矢印ボタンで調整すると「6pt」刻みで値が上下し、「行間の倍数」は「0.5」刻みで値が上下するので微調整するには手入力が必要になります。

値を変更してもプレビューがなく、行間の広がり具合を確認するときは、「OK」をクリックして「段落」ダイアログボックスを一度閉じなければいけません。

よって、広がり具合を予想しながら調整しなくてはならず、とってもフワフワした作業になってしまいます。

そこで、PowerPoint VBAを使い、Illustratorの文字パネルを操作するように行間を「1pt」刻みで調整できるマクロを作りました。

段落後を広げるマクロ

段落後を「1pt」刻みで広げるマクロです。

コード

Sub 段落後を広げる()

    Dim sa As Single

    With ActiveWindow.Selection
  
        'シェイプまたはテキスト範囲が選択されていない場合
        If .Type = ppSelectionNone Or .Type = ppSelectionSlides Then
        
            'メッセージ
            MsgBox "シェイプまたはテキスト範囲を選択してください。"
            'マクロを終了
            Exit Sub
            
        End If
    
    'テキストに合わせて図形のサイズを調整する
    .ShapeRange.TextFrame.AutoSize = ppAutoSizeShapeToFitText

    With .TextRange.ParagraphFormat
    
        '段落後を取得
        sa = .SpaceAfter
        '行間を倍数で設定
        .LineRuleAfter = msoFalse
        '行間を広げる
        .SpaceAfter = sa + 1

    End With
  End With
End Sub

広げる間隔は、下記コードの値で変更します。

'行間を広げる
.SpaceAfter = sa + 1

段落後を詰めるマクロ

段落後を「1pt」刻みで詰めるマクロです。

コード

Sub 段落後を詰める()

    Dim sa As Single

    With ActiveWindow.Selection
  
        'シェイプまたはテキスト範囲が選択されていない場合
        If .Type = ppSelectionNone Or .Type = ppSelectionSlides Then
        
            'メッセージ
            MsgBox "シェイプまたはテキスト範囲を選択してください。"
            'マクロを終了
            Exit Sub
            
        End If
    
    'テキストに合わせて図形のサイズを調整する
    .ShapeRange.TextFrame.AutoSize = ppAutoSizeShapeToFitText

    With .TextRange.ParagraphFormat
    
        '段落後を取得
        sa = .SpaceAfter
        '行間を倍数で設定
        .LineRuleAfter = msoFalse
        '行間を詰める
        .SpaceAfter = sa - 1

    End With
  End With
End Sub

詰める間隔は、下記コードの値で変更します。

'行間を詰める
.SpaceAfter = sa - 1

行間を倍数で広げるマクロ

行間の倍数を「0.1」刻みで広げるマクロです。

コード

Sub 行間を倍数で広げる()

    Dim fs As Single
    Dim sw As Single

    With ActiveWindow.Selection
  
        'シェイプまたはテキスト範囲が選択されていない場合
        If .Type = ppSelectionNone Or .Type = ppSelectionSlides Then
        
            'メッセージ
            MsgBox "シェイプまたはテキスト範囲を選択してください。"
            'マクロを終了
            Exit Sub
            
        End If
    
    'テキストに合わせて図形のサイズを調整する
    .ShapeRange.TextFrame.AutoSize = ppAutoSizeShapeToFitText
    
    'フォントサイズを取得
    fs = .TextRange.Font.Size

    With .TextRange.ParagraphFormat
        
        If .LineRuleWithin = msoFalse Then
        
            '固定値で設定されている場合は倍数へ変換
            .SpaceWithin = .SpaceWithin / fs / 1.2
        
        End If
        
        '行間の倍数を取得
        sw = .SpaceWithin
        '行間を倍数で設定
        .LineRuleWithin = msoTrue
        '行間を広げる
        .SpaceWithin = sw + 0.1

    End With
  End With
End Sub

広げる間隔は、下記コードの値で変更します。

'行間を広げる
.SpaceWithin = sw + 0.1

行間を倍数で詰めるマクロ

行間の倍数を「0.1」刻みで詰めるマクロです。

コード

Sub 行間を倍数で詰める()

    Dim fs As Single
    Dim sw As Single

    With ActiveWindow.Selection
  
        'シェイプまたはテキスト範囲が選択されていない場合
        If .Type = ppSelectionNone Or .Type = ppSelectionSlides Then
        
            'メッセージ
            MsgBox "シェイプまたはテキスト範囲を選択してください。"
            'マクロを終了
            Exit Sub
            
        End If
    
    'テキストに合わせて図形のサイズを調整する
    .ShapeRange.TextFrame.AutoSize = ppAutoSizeShapeToFitText
    
    'フォントサイズを取得
    fs = .TextRange.Font.Size

    With .TextRange.ParagraphFormat
        
        If .LineRuleWithin = msoFalse Then
        
            '固定値で設定されている場合は倍数へ変換
            .SpaceWithin = .SpaceWithin / fs / 1.2
        
        End If
        
        '行間の倍数を取得
        sw = .SpaceWithin
        '行間を倍数で設定
        .LineRuleWithin = msoTrue
        '行間を詰める
        .SpaceWithin = sw - 0.1

    End With
  End With
End Sub

詰める間隔は、下記コードの値で変更します。

'行間を詰める
.SpaceWithin = sw - 0.1

段落と行間の値をリセットするマクロ

シェイプに設定した段落前、段落後、行間の値をリセットして初期値に戻すマクロです。

コード

Sub 段落と行間をリセット()

    With ActiveWindow.Selection
  
        'シェイプが選択されていない場合はマクロを終了
        If .Type = ppSelectionNone Or .Type = ppSelectionSlides Then
        
            'メッセージ
            MsgBox "シェイプを選択してください。"
            'マクロを終了
            Exit Sub
            
        End If
    
    'テキスト編集モードの場合はシェイプを選択
    If .Type = ppSelectionText Then .ShapeRange.Select
    
    'テキストに合わせて図形のサイズを調整する
    .ShapeRange.TextFrame.AutoSize = ppAutoSizeShapeToFitText

    With .TextRange.ParagraphFormat
        
        '段落前をリセット
        .SpaceBefore = 0
        
        '段落後をリセット
        .SpaceAfter = 0
        
        '行間を倍数で設定
        .LineRuleWithin = msoTrue
        '行間をリセット
        .SpaceWithin = 1

    End With
  End With
End Sub

行間マクロの実行方法

文字列が含まれたシェイプを選択して実行します。一部の段落のみ調整したい場合は、段落の文字の間にカーソルを挿入、またはテキスト範囲で指定して実行します。

複数シェイプの選択や段落をまたいでの選択の調整には対応していません。

行間の設定をマスターする

行間の設定は、「段落後」と「行間の倍数」の使い方をマスターすると上達します。

詳細は、次の記事で解説しています。

PowerPointの箇条書き・行間の設定を最速でマスターする講座

PowerPointで文字の箇条書きと行間の設定がうまくいかない時に、ご参考にしていただきたい内容で…

パワポの文字間隔の微調整は時間がかかる

PowerPointで文字間隔を微調整するときは、「ホーム」タブ →「フォント」グループ →「文字の間隔」→「その他の間隔」を選択して「フォント」ダイアログボックスを開きます。

続いて、「フォント」ダイアログボックスの「間隔」から「文字間隔を広げる」「文字間隔をつめる」を選択し、「幅」の値を調整します。

「幅」の値を変更してもプレビューがなく、文字間隔の広がり具合を確認するときは、「OK」をクリックして「フォント」ダイアログボックスを一度閉じなければいけません。

よって、広がり具合を予想しながら調整しなくてはならず、とってもフワフワした作業になってしまいます。

そこで、PowerPoint VBAを使い、Illustratorの文字パネルを操作するように、文字間隔を「1pt」刻みで調整できるマクロを作りました。

文字間隔を広げるマクロ

文字間隔を「1pt」刻みで広げるマクロです。

コード

Sub 文字間隔を広げる()

    Dim cs As Single

    With ActiveWindow.Selection
  
        'シェイプまたはテキスト範囲が選択されていない場合
        If .Type = ppSelectionNone Or .Type = ppSelectionSlides Then
        
            'メッセージ
            MsgBox "シェイプまたはテキスト範囲を選択してください。"
            'マクロを終了
            Exit Sub
            
        End If
    
    'テキストに合わせて図形のサイズを調整する
    .ShapeRange.TextFrame.AutoSize = ppAutoSizeShapeToFitText

    With .TextRange2.Characters.Font
    
        '現在の文字間隔を取得
        cs = .Spacing
        '文字間隔を広げる
        .Spacing = cs + 1

    End With
  End With
End Sub

広げる間隔は、下記コードの値で変更します。

'文字間隔を広げる
.Spacing = cs + 1

文字間隔を詰めるマクロ

文字間隔を「1pt」刻みで詰めるマクロです。

コード

Sub 文字間隔を詰める()

    Dim cs As Single

    With ActiveWindow.Selection
  
        'シェイプまたはテキスト範囲が選択されていない場合
        If .Type = ppSelectionNone Or .Type = ppSelectionSlides Then
        
            'メッセージ
            MsgBox "シェイプまたはテキスト範囲を選択してください。"
            'マクロを終了
            Exit Sub
            
        End If
    
    'テキストに合わせて図形のサイズを調整する
    .ShapeRange.TextFrame.AutoSize = ppAutoSizeShapeToFitText

    With .TextRange2.Characters.Font
    
        '現在の文字間隔を取得
        cs = .Spacing
        '文字間隔を詰める
        .Spacing = cs - 1

    End With
  End With
End Sub

詰める間隔は、下記コードの値で変更します。

'文字間隔を詰める
.Spacing = cs - 1

文字間隔マクロの実行方法

文字列が含まれたシェイプを選択、またはシェイプ内の調整したいテキスト範囲を選択して実行します。

複数シェイプの選択には対応していません。

マクロを連続で実行するには？

前項のマクロは、連続実行した時に最大の効果を発揮します。

連続実行する方法は、次のチュートリアルをご参考にしていただければ幸いです。

PowerPointでマクロを連続実行して爆速で作業する方法

PowerPointでマクロの実行ボタンを連打して爆速で作業する方法をご紹介します。行間や字間を「1…

パワポの行間の微調整は時間がかかる

段落後を広げるマクロ

コード

段落後を詰めるマクロ

コード

行間を倍数で広げるマクロ

コード

行間を倍数で詰めるマクロ

コード

段落と行間の値をリセットするマクロ

コード

行間マクロの実行方法

行間の設定をマスターする

パワポの文字間隔の微調整は時間がかかる

文字間隔を広げるマクロ

コード

文字間隔を詰めるマクロ

コード

文字間隔マクロの実行方法

マクロを連続で実行するには？

人気記事