【Excel VBA】画像のみ一括削除する方法！サイズによる範囲指定も！

Excel VBAで複数の画像のみ一括選択して削除したいときはないでしょうか。

例えば､あるExcelシートに画像以外のオブジェクトが含まれていて､その中から画像のみ選択の上、削除をしたいときなどです｡

けど、そんな中で悩むことは、

・削除するために画像を一つ一選択しなければならず面倒。
・基本操作やVBAで効率的に行いたいがやり方がわからない。

ですよね。

今回はそんなお悩みを解決する
Excel VBAで画像のみ一括選択して削除する方法について
まとめます！

Excel で画像を削除する基本操作

Excel で画像を削除する基本操作について説明をします。

以下のように画像以外にもチェックボックスや画像など他のオブジェクトが混在しているシートがあり、画像のみ削除をしていきます。

［ホーム］タブから「オブジェクトの選択」を選択する

［ホーム］タブから「オブジェクトの選択」を選択します。

画像のみであれば、「条件を指定してジャンプ」を選択し、選択オプションウインドウの「オブジェクト」を選択し「OK」を押します。

画像の選択ができました。

タカヒロ

「オブジェクトの選択」をしなくても左クリックで選択可能です。

画像を削除する

削除したい画像を選択したらキーボードのDeleteキーを押します。

削除できましたね。

Excel VBAで複数の画像を選択し、削除する

次はこれまで手動で行ってきた画像の選択と削除をVBAで一度に処理していきます。

処理対象は手動で行ったものと同様です。

シートにあるすべてのオブジェクトから画像のみを選択するVBA

削除を行う上で、シートにあるすべてのオブジェクトから画像のみを選択する処理をおこないます。

VBAは以下の通りです。

Sub 画像のみ一括選択する()
    Dim chkBox As Excel.CheckBox
    Dim objShape As Object
    Dim arr() As String
    ReDim Preserve arr(0)

    '選択シートに存在するオブジェクトを取得します。
    For Each objShape In ActiveSheet.Shapes
    
        arr(UBound(arr)) = objShape.Name
        
        'オブジェクトのタイプが画像であるか判定します。
        If objShape.Type = msoPicture Then
        
            '画像オブジェクトの名前を配列に追加します。
            arr(UBound(arr)) = objShape.Name
            
            '値を保持したまま配列を最大インデックスを追加します。
            ReDim Preserve arr(UBound(arr) + 1)
        
        End If
        
    Next
    
    '空の値を削除します。
    ReDim Preserve arr(UBound(arr) - 1)
    
    '画像オブジェクトを選択します。
    ActiveSheet.Shapes.Range(arr).Select

End Sub

マクロメニューの「画像のみ一括選択する」を選択し、VBAを実行します。

はい、画像のみが選択されましたね。

タカヒロ

VBAの実装方法や実行手順については以下の項目をご参照ください。

VBAの説明

For Eachで選択シートに存在するオブジェクトを取得します。

For Each objShape In ActiveSheet.Shapes

オブジェクトのタイプが画像であるか判定します。

If objShape.Type = msoPicture Then

タカヒロ

画像以外にもオブジェクトの形式が指定することができます。

定数	説明	値
msoShapeTypeMixed		-2
msoAutoShape	図形／オートシェイプ	1
msoCallout	吹き出し	2
msoChart	グラフ	3
msoComment	コメント	4
msoGroup	グループ化された図形	6
msoLinkedPicture	リンク画像	11
msoPicture	画像	13
msoTextBox	テキストボックス	17
msoTable	表	19

画像オブジェクトの名前を配列に追加します。

arr(UBound(arr)) = objShape.Name

値を保持したまま配列を最大インデックスを追加します。

ReDim Preserve arr(UBound(arr) + 1)

空の値を削除します。

ReDim Preserve arr(UBound(arr) – 1)

最後に配列にある値の名前委の画像オブジェクトを選択します。

ActiveSheet.Shapes.Range(arr).Select

選択した画像のみを選択し削除するVBA

次は選択した画像を削除していきます。

Sub 画像のみ一括選択し削除する()
    Dim chkBox As Excel.CheckBox
    Dim objShape As Object
    Dim arr() As String
    ReDim Preserve arr(0)

    '選択シートに存在するオブジェクトを取得します。
    For Each objShape In ActiveSheet.Shapes
    
        arr(UBound(arr)) = objShape.Name
        
        'オブジェクトのタイプが画像であるか判定します。
        If objShape.Type = msoPicture Then
        
            '画像オブジェクトの名前を配列に追加します。
            arr(UBound(arr)) = objShape.Name
            
            '値を保持したまま配列を最大インデックスを追加します。
            ReDim Preserve arr(UBound(arr) + 1)
        
        End If
        
    Next
    
    '空の値を削除します。
    ReDim Preserve arr(UBound(arr) - 1)
    
    '画像オブジェクトを選択します。
    ActiveSheet.Shapes.Range(arr).Select
    
    '選択オブジェクトを削除します。
    Selection.Delete

End Sub

マクロメニューの「画像のみ一括選択して削除する」を選択し、VBAを実行します。

選択した画像が削除されましたね。

VBAの説明

選択までの処理は上記VBAと同様で、
最後に選択オブジェクトを削除する処理を加えています。

Selection.Delete

画像の高さを指定して選択した画像を削除するVBA

続いて画像の高さであるサイズを指定して一定サイズ以上であれば削除していきます。

3番目の画像サイズを大きくし、こちらを削除対象とする処理を加えていきます。

画像の高さはVBAではピクセル単位で指定する必要があります。

右クリックのメニューからサイズは確認することはできますが、
センチメートルの単位となりますので、変換が必要となり少々面倒です。

ですので、以下のVBAでピクセル単位のサイズを調べてみます。

Sub 選択オブジェクトのサイズを調べる()
    MsgBox "幅" & Selection.Width & "ピクセル" & vbCrLf & "高さ" & Selection.Height & "ピクセル"
End Sub

今回は一番小さい高さである画像を対象としたいので、その画像を選択して、VBAを実行します。

サイズが表示されましたね。

高さは115.5ピクセルでしたので、115ピクセル以上を条件にサイズを指定し、
画像を削除していきましょう。

以下VBAです。

Sub 高さ指定サイズの画像のみ一括選択して削除する()
    Dim chkBox As Excel.CheckBox
    Dim objShape As Object
    Dim arr() As String
    ReDim Preserve arr(0)

    '選択シートに存在するオブジェクトを取得します。
    For Each objShape In ActiveSheet.Shapes
    
        arr(UBound(arr)) = objShape.Name
        
        'オブジェクトのタイプが画像であるか判定します。
        If objShape.Type = msoPicture And objShape.Height >= 115 Then
        
            '画像オブジェクトの名前を配列に追加します。
            arr(UBound(arr)) = objShape.Name
            
            '値を保持したまま配列を最大インデックスを追加します。
            ReDim Preserve arr(UBound(arr) + 1)
        
        End If
        
    Next
    
    '空の値を削除します。
    ReDim Preserve arr(UBound(arr) - 1)
    
    '画像オブジェクトを選択します。
    ActiveSheet.Shapes.Range(arr).Select
    
    '選択オブジェクトを削除します。
    Selection.Delete

End Sub

Selection.Delete
手前でブレイクして選択されているか確認します。

はい、指定サイズの画像のみ選択されていますね。