HOME > Q&A > Excel （VBA）

Excel （VBA）
Excel VBAに関するフォーラムです。
  • 解決済みのトピックにはコメントできません。
このトピックは解決済みです。
質問

 
(Windows 11 Pro : その他)
オートシェイプのひし形だけ消す
投稿日時: 23/07/24 13:38:37
投稿者: あかつき2023

お世話になります。
 
Excelのシート上に作成した、ひし形のオートシェイプを全部消すボタンを作成しているのですが、
うまく動作していません。実行すると
 
実行時エラー：438
オブジェクトは、このプロパティまたはメソッドをサポートしていません。
 
とエラーになってしまいます。
 
アドバイスをいただけませんでしょうか、
よろしくお願いいたします。
 
作成したコード：
 
Sub sakujyo
    ActiveSheet.msoShapeDiamond.Delete
End Sub
投稿日時: 23/07/24 13:52:12
投稿者: あかつき2023

他にシート上には円のオートシェイプもあり、円だけを削除するコードも作成しました。
これはうまく円だけを削除できています。
 
Sub sakujyo2
    ActiveSheet.Ovals.Delete
End Sub
回答
投稿日時: 23/07/24 14:23:31
投稿者: taitani
投稿者のウェブサイトに移動

ひし形 (Type 4) も四角 (Type 1)として認識されてしまうので、エラーが発生している見解です。
 
以下を利用してみてください。
 

Sub Hishi_sakujyo()
    Dim shp As Shape
    Dim i As Long
    
    i = 1
    Do While i <= ActiveSheet.Shapes.Count
        Set shp = ActiveSheet.Shapes(i)
        If shp.AutoShapeType = msoShapeDiamond Then
            shp.Delete
        Else
            i = i + 1
        End If
    Loop
End Sub
回答
投稿日時: 23/07/24 15:12:27
投稿者: sk

引用:
Excelのシート上に作成した、ひし形のオートシェイプを全部消す

（標準モジュール）
---------------------------------------------------------------
Sub DeleteAllDiamonds()
 
    Dim shpTarget As Excel.Shape
    Dim lngDeletedCount As Long
     
    Application.ScreenUpdating = False
     
    For Each shpTarget In ActiveSheet.Shapes
        With shpTarget
            If .Type = msoAutoShape Then
                If .AutoShapeType = msoShapeDiamond Then
                    .Delete
                    lngDeletedCount = lngDeletedCount + 1
                End If
            End If
        End With
    Next
 
    Application.ScreenUpdating = True
 
    Dim strMsgText As String
 
    If lngDeletedCount = 0 Then
        strMsgText = "アクティブシートにひし形はありません。"
    Else
        strMsgText = lngDeletedCount & "個のひし形を削除しました。"
    End If
 
    MsgBox strMsgText, vbInformation, "実行完了"
 
End Sub
---------------------------------------------------------------
 
引用:
実行時エラー：438
オブジェクトは、このプロパティまたはメソッドをサポートしていません。

引用:
ActiveSheet.msoShapeDiamond.Delete

・Excel.Worksheet オブジェクトに msoShapeDiamond という名前の
　メンバーは存在しない。
 
・また、「ワークシート上の全てのひし形（のみ）の集合」を
　コレクションとして返すプロパティやメソッドはサポートされていない。
 
引用:
ActiveSheet.Ovals.Delete

・Ovals メソッドは過去のバージョンとの下位互換性のために
　残されているメンバーであり、現在のバージョンの Excel では
　Excel.Worksheet オブジェクトの非表示メンバーとなっている。
投稿日時: 23/07/24 16:50:34
投稿者: あかつき2023

taitani様
sk様
 
＞Excel.Worksheet オブジェクトに msoShapeDiamond という名前の
　メンバーは存在しない。
勉強になりました。
 
無事に解決いたしました、
ありがとうございました！