エクセルVBAで、ワードアート削除するには？

質問

エクセルマクロ初心者でして、どうかご迷惑おかけするかもしれませんが、どうか助けていただけないでしょうか？

エクセルマクロで名刺作ってまして、ワードアートをA1に作成して、A2～B6にコピーして作ってます。
しかし、ワードアートの一部分が間違えて変更する際に、A2～B6を
削除するのが大変なんですよ・・・

セルA2～B6のワードアートを指定して削除するVBAは、どうやってつくるのか、どなたか教えていただけないでしょうか？

一括削除だったら、原画のA1まで消えてしまって・・・（￣～￣）ンー

回答No.4

ja7awu

> ワードアートだけでなく、セルに文字や、写真（JPEGが多い）も
> 入れることがありまして、そういった場合Objectになるのですかね？
> セルに入った文字がひっかかってしまって・・・

それなら、こんな感じです。

セル A2:B6 の内容と、その範囲内に左上点がある Shapes、Picture等のDrawingObjects を
全て削除します。(セル内容は消去)

Sub test()
Dim Obj As Object
Range("A2:B6").Clear
For Each Obj In ActiveSheet.DrawingObjects
　　If Not Intersect(Range("A2:B6"), Obj.TopLeftCell) Is Nothing Then Obj.Delete
Next
End Sub

回答No.3

ja7awu

おっと!!　質問内容を忠実に解釈するとこんな感じです。

WordArtの左上角が「セルA2:B6に入っているものだけを削除」するのであれば、こんな感じです。

Sub test()
Dim Shp As Shape
For Each Shp In ActiveSheet.Shapes
　　If InStr(Shp.Name, "WordArt") = 1 Then
　　　　If Not Intersect(Range("A2:B6"), Shp.TopLeftCell) Is Nothing Then Shp.Delete
　　End If
Next
End Sub

補足

しまった、言い忘れてました・・・

ワードアートだけでなく、セルに文字や、写真（JPEGが多い）も
入れることがありまして、そういった場合Objectになるのですかね？
セルに入った文字がひっかかってしまって・・・

初心者で申し訳ないです。（￣～￣）ンー

回答No.2

ja7awu

こんな感じで如何でしょうか？

WordArtの左上角がセルA1に入っているものを残し、削除します。

Sub test()
Dim Shp As Shape
For Each Shp In ActiveSheet.Shapes
　　If InStr(Shp.Name, "WordArt") = 1 Then
　　　　If Shp.TopLeftCell.Address <> "$A$1" Then Shp.Delete
　　End If
Next
End Sub

お礼

なるほど、うまくいきました＾＾

Ａ１以外ってのが頭に浮かびませんでした＾＾；

なんと言ってお礼をいいやら、誠にありがとうございました。
ご恩は一生忘れません。

回答No.1

ham_kamo

あくまで
・A1が一番最初に作成された
・ワードアート以外のShapeオブジェクト（図形など）がない
場合限定ですが、以下のマクロでできませでしょうか。
（実行するときに念のためシートのバックアップ（コピー）をとっておいた方がよいかと思います）

Sub ワードアートを削除()
　　Do While Shapes.Count > 1
　　　　Shapes(2).Delete
　　Loop
End Sub

お礼

Do While Shapes.Count > 1　　←ここでひっかりました＾＾；

ありがたい回答で感謝であります。

先に回答された方のを採用させてもらいました。
お手数おかけしました。