PowerPoint VBA 指定ピクセルに変換して図として保存するマクロ

PowerPoint VBAを使い、画像や図形を指定ピクセルにサイズを変更して図として保存するマクロをご紹介します。

WEB用素材の書き出しに便利なマクロです。

指定ピクセルに変換して図として保存するマクロ

コード

Sub 指定ピクセルで図として保存()

    Dim w As Single
    Dim filePath As String
    Dim fileName As String
    
    With ActivePresentation
    
        '保存場所
        filePath = .Path
        
        'ファイル名
        fileName = Left(.Name, InStrRev(.Name, ".") - 1)
    
    End With
    
    With ActiveWindow.Selection

        'シェイプまたは画像が選択されている場合
        If .Type = ppSelectionShapes Then
        
            '角丸の半径を入力
            w = InputBox("幅を入力してください。" & vbCrLf & _
            "(単位: px)")
            
            'センチに変換
            w = w * 0.02647
            
            'インチに変換
            w = w / 2.54 * 72
            
            '数値以外が入力された場合はマクロを終了
            If IsNumeric(Radius) Then
                ElseIf Radius = "" Then
                Exit Sub
            Else
                msg = "数値を入力してください。"
                MsgBox msg
                Exit Sub
            End If
            
            With .ShapeRange
            
                '縦横比を固定する
                .LockAspectRatio = msoTrue
            
                '幅を変更
                .Width = w
                
                'PNGで図として保存
                .Export _
                PathName:=filePath & "\" & fileName & ".png", _
                Filter:=ppShapeFormatPNG
                
            End With
        Else
            'シェイプまたは画像が選択されていない場合はマクロを終了
            MsgBox "シェイプまたは画像を選択してください。"
            Exit Sub
        End If
    End With
End Sub

保存場所を指定する

保存場所は「filePath = .Path」で現在ファイルがある同じ階層に保存されるようにしています。指定の場所に保存したい場合は、「filePath = “C:\Users\ユーザー名\Desktop”」など、保存場所までのパスに変更しましょう。

保存場所にフォルダーを指定する場合は、フォルダーを「Shift + 右クリック」でメニューを開き、「パスのコピー」をして貼り付けると簡単です。

実行方法

画像や図形を選択して実行します。

ダイアログボックスが開くので、幅の値をピクセル単位で指定して「OK」をクリックします。

指定した幅にサイズが変更されて保存されました。