PowerPoint VBA フチ文字（袋文字）を作るマクロ

PowerPoint VBAを使い、フチ文字（袋文字）を作るマクロをご紹介します。

Illustratorではアピアランスを使って1つのテキストボックスでフチ文字を作ることができますが、パワポではテキストボックスを重ねて作る必要があります。

そこでパワポでも簡単にフチ文字が作れるマクロの登場です。

フチ文字を作成するマクロ

コード

Sub フチ文字作成()

    Dim n As Long
    Dim msg As String
    Dim fuchimoji As String
    Dim lineColor As Long
    Dim lineWeight As String
    
    '選択中のスライド番号を取得
    n = ActiveWindow.Selection.SlideRange.SlideIndex

    '選択中のテキストボックスをコピー
    With ActiveWindow.Selection

        'テキストボックスが選択されていない場合はマクロ終了
        If .Type = ppSelectionNone _
        Or .Type = ppSelectionSlides Then
        
            msg = "テキストボックスを選択してください。"
            MsgBox msg
            Exit Sub
            
        End If
    
        With .ShapeRange
        
            'テキストボックスの名前
            .Name = "txt1"
            '最前面へ移動
            .ZOrder msoBringToFront
            'テキストボックスをコピー
            .Copy
            'テキストボックスの位置を代入
            x = .Top
            y = .Left
            '文字色を代入
            lineColor = .TextFrame.TextRange.Font.Color.RGB
            
        End With
    End With
    
    'フチ文字のタイプを選択
    fuchimoji = InputBox( _
    "作成番号を入力してください。" & vbCrLf & vbCrLf & _
    "1：一重フチ文字" & vbCrLf & _
    "2：二重フチ文字")

    'フチ文字を作成
    Select Case fuchimoji
    
        '一重フチ文字の場合
        Case 1, "１"
            '線幅の設定
            lineWeight = InputBox("線幅を入力してください。（単位：pt）")
            '半角数字以外が入力された場合はマクロ終了
            If IsNumeric(lineWeight) Then
            ElseIf lineWeight = "" Then
                Exit Sub
            Else
                msg = "半角数字を入力してください。"
                MsgBox msg
                Exit Sub
            End If
        
            'フチ文字の設定
            With ActivePresentation.Slides(n).Shapes.Paste
                'テキストボックスの名前
                .Name = "txt2"
                '背面へ移動
                .ZOrder msoSendBackward
                'テキストボックス移動
                .Top = x
                .Left = y
                '文字線幅
                .TextFrame2.TextRange.Font.Line.Weight = lineWeight
                '文字色
                .TextFrame.TextRange.Font.Color.RGB = lineColor
                .TextFrame2.TextRange.Font.Line.ForeColor.RGB = lineColor
            End With
            
            With ActivePresentation.Slides(n).Shapes
                '元のテキストボックスの文字色
                .Range("txt1").TextFrame.TextRange.Font.Color.RGB = RGB(255, 255, 255)
                'テキストボックスをグループ化
                .Range(Array("txt1", "txt2")).Group
            End With

        '二重フチ文字の場合
        Case 2, "２"
            '線幅の設定
            lineWeight = InputBox("線幅を入力してください。（単位：pt）")
            '半角数字以外が入力された場合はマクロ終了
            If IsNumeric(lineWeight) Then
            ElseIf lineWeight = "" Then
                Exit Sub
            Else
                msg = "半角数字を入力してください。"
                MsgBox msg
                Exit Sub
            End If

            '一重目のフチ文字の設定
            With ActivePresentation.Slides(n).Shapes.Paste
                'テキストボックスの名前
                .Name = "txt2"
                '背面へ移動
                .ZOrder msoSendBackward
                'テキストボックス移動
                .Top = x
                .Left = y
                '文字線幅
                .TextFrame2.TextRange.Font.Line.Weight = lineWeight
                '文字色
                .TextFrame.TextRange.Font.Color.RGB = RGB(255, 255, 255)
                .TextFrame2.TextRange.Font.Line.ForeColor.RGB = RGB(255, 255, 255)
             End With

            '二重目のフチ文字の設定
            With ActivePresentation.Slides(n).Shapes.Paste
                'テキストボックスの名前
                .Name = "txt3"
                '背面へ移動
                .ZOrder msoSendBackward
                .ZOrder msoSendBackward
                'テキストボックス移動
                .Top = x
                .Left = y
                '文字線幅
                .TextFrame2.TextRange.Font.Line.Weight = lineWeight * 2
                '文字色
                .TextFrame.TextRange.Font.Color.RGB = lineColor
                .TextFrame2.TextRange.Font.Line.ForeColor.RGB = lineColor
            End With

            With ActivePresentation.Slides(n).Shapes
                'テキストボックスをグループ化
                .Range(Array("txt1", "txt2", "txt3")).Group
            End With
            
        Case Is = ""
            Exit Sub
                
        Case Else
            '指定の数字以外が入力された場合はマクロ終了
            msg = "指定の数字を入力してください。"
            MsgBox msg
            Exit Sub
    End Select
End Sub

実行結果

一重フチ文字を作成する

テキストボックスを用意します。

テキストボックスを選択してマクロを実行すると、作成番号入力ダイアログボックスが開くので、一重フチ文字の「1」を入力して「OK」をクリックします。

続いて、線幅入力ダイアログボックスが開くので、線幅を入力して「OK」をクリックします。

一重フチ文字ができました。線の色はテキストに設定していた色になり、テキストの色は白になる設定にしています。つまり、線に設定したい色を塗りに設定して実行すれば、作成後に選択しづらい背面の線色を変更せずに済みます。

二重フチ文字を作成する

テキストボックスを用意します。

作成番号入力ダイアログボックスで二重フチ文字の「2」を入力して「OK」をクリックします。

続いて、線幅入力ダイアログボックスが開くので、線幅を入力して「OK」をクリックします。

二重フチ文字ができました。最背面の線の色はテキストに設定していた色になり、中間の線の色は白になる設定にしています。最背面の線幅は、入力した値の2倍に設定しています。

マクロのパワーでフチ文字革命が起きました。

フチ文字の線幅を調整するマクロ

フチ文字の線幅をテキストを重ねた状態で調整するマクロをご紹介します。通常なら、前面テキストをずらして背面テキストの線幅を調整しますが、マクロを使えばテキストを重ねた状態で調整することができます。

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

PowerPoint VBA 重ねたフチ文字の線幅を調整するマクロ

PowerPoint VBAを使い、テキストボックスを重ねて作ったフチ文字（袋文字）の背面のテキスト…

ppdtp.com

2021.01.24