PowerPoint VBA 囲み文字を自動作成するマクロ

PowerPoint VBAを使い、1文字から複数行まで対応した囲み文字を自動作成するマクロをご紹介します。

塗りで囲むタイプと線で囲むタイプが作れます。囲み文字解除機能付きで、囲むのをやめるのもサクッと行えます。

この記事の目次

囲み文字を自動作成するマクロ
1. コード
2. 実行結果

囲み文字を自動作成するマクロ

コード

Sub 囲み文字を作成()

    Dim nowTop As Single
    Dim nowLeft As Single
    Dim marginSize As Single
    Dim nowMarginTop As Single
    Dim nowMarginLeft As Single
    Dim kakomimoji As String
    
    With ActiveWindow.Selection
  
        'テキストボックスが選択されていない場合はマクロ終了
        If .Type = ppSelectionNone _
        Or .Type = ppSelectionSlides Then
        
            MsgBox "テキストボックスを選択してください。"
            Exit Sub
          
        End If
        
        'テキスト編集モードの場合はシェイプを選択
        If .Type = ppSelectionText Then .ShapeRange.Select
        
        '余白を「cm」で指定
        marginSize = 0.2
        '余白を「pt」に変換
        marginSize = Round(marginSize * 720 / 25.4, 1)
            
        With .ShapeRange
            
            '囲み文字のタイプを選択
            kakomimoji = InputBox( _
            "作成番号を入力してください。" & vbCrLf & vbCrLf & _
            "1：塗りで囲む" & vbCrLf & _
            "2：線で囲む" & vbCrLf & _
            "3：囲みを取る")
        
            '囲み文字を作成
            Select Case kakomimoji
            
                '塗りで囲む
                Case 1, "１"
                
                    'テキストの色
                    .TextFrame.TextRange.Font.Color.RGB = RGB(255, 255, 255)
                    '四角形の色
                    .Fill.ForeColor.RGB = RGB(0, 0, 0)
                    '塗りあり
                    .Fill.Visible = msoTrue
                    '線なし
                    .Line.Visible = msoFalse
        
                '線で囲む
                Case 2, "２"
                
                    'テキストの色
                    .TextFrame.TextRange.Font.Color.RGB = RGB(0, 0, 0)
                    '線の色
                    .Line.ForeColor.RGB = RGB(0, 0, 0)
                    '線幅
                    .Line.Weight = 1
                    '塗りなし
                    .Fill.Visible = msoFalse
                    '線あり
                    .Line.Visible = msoTrue
                    
                '囲みを取る
                Case 3, "３"
                
                    'テキストの色
                    .TextFrame.TextRange.Font.Color.RGB = RGB(0, 0, 0)
                    '塗りなし
                    .Fill.Visible = msoFalse
                    '線なし
                    .Line.Visible = msoFalse
                    '余白なし
                    marginSize = 0
            
                Case ""
                
                    Exit Sub
                        
                Case Else
                
                    '指定の数字以外が入力された場合はマクロ終了
                    msg = "指定の数字を入力してください。"
                    MsgBox msg
                    Exit Sub
                    
            End Select
    
            '現在の位置を代入
            nowTop = .Top
            nowLeft = .Left
            
            With .TextFrame
                    
                '現在の余白を代入
                nowMarginTop = .MarginTop
                nowMarginLeft = .MarginLeft
     
                '余白の設定
                .MarginLeft = marginSize
                .MarginRight = marginSize
                .MarginTop = marginSize
                .MarginBottom = marginSize
                
                'テキストに合わせて図形のサイズを調整する
                .AutoSize = ppAutoSizeShapeToFitText
                'テキストを左右中央揃えにする
                .TextRange.ParagraphFormat.Alignment = ppAlignCenter
                'テキストを上下中央揃えにする
                .VerticalAnchor = msoAnchorMiddle
                
            End With
            
            '元の位置に移動
            .Top = nowTop + nowMarginTop - marginSize
            .Left = nowLeft + nowMarginLeft - marginSize
                
        End With
    End With
End Sub