PowerPointについての「よくあるご質問」はこちらからご覧いただけます。
スポンサーリンク
スポンサーリンク

PowerPoint VBA 袋文字(フチ文字)を作るマクロ

PowerPointで袋文字(フチ文字)を作る場合、テキストに線幅を設定すると塗りがやせてしまうため、背面に重ねたテキストの線幅を太くする方法で作成します。

Illustratorでは、アピアランス機能を使って1つのテキストで袋文字を作成することが可能ですが、PowerPointではテキストの塗りと線の重ね順を変更できない為、テキストを二重にして作る必要があります。

Illustrator 8.0までの作り方ですね。

PowerPointよ、時代はもう令和ですぞ。

そんなこんなで、作業が劇的に早くなる!PowerPointで簡単に「一重袋文字」と「二重袋文字」が作成できるマクロをご紹介します。

スポンサーリンク

袋文字を作成するマクロ

コード

Sub 袋文字作成()

    Dim n As Long
    Dim msg As String
    Dim fukuromoji As String
    Dim lineColor As Long
    Dim lineWeight As Double
    Dim lineWeight2 As Double
    
    '選択中のスライド番号を取得
    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
    
    '袋文字のタイプを選択
    fukuromoji = InputBox( _
    "作成番号を入力してください。" & vbCrLf & vbCrLf & _
    "1:一重袋文字" & vbCrLf & _
    "2:二重袋文字")

    '袋文字を作成
    Select Case fukuromoji
    
        '一重袋文字の場合
        Case Is = 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 Is = 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のパワーで袋文字革命が起きました。