• ベストアンサー

エクセルVBAでAutoShape削除

moooonの回答

  • moooon
  • ベストアンサー率26% (26/98)
回答No.1

しらべてみたら、線のAutoShapeTypeは-2でした。 星は92でした。 だから、こうやったら両方とも削除できました。 For Each s In .Shapes Select Case s.AutoShapeType Case 92, -2 s.Delete End Select Next

merlionXX
質問者

お礼

ありがとうございます。 これはいい!と思って試したら、星と線だけではなく、ワードアートやフォームから入れたボタンやチェックボックス等も削除されてしまいました。 フォームから挿入したものもAutoShapeTypeは-2のようです。

関連するQ&A

  • エクセルVBAでオートシェープを識別して削除したいのです・・・

    エクセルシートにたくさん貼り付けた画像を一度に削除するため、下記のようなマクロを作成しました。 しかし、これでは「テキストボックス」や「→」のようなオートシェープも全部消えてしまいます。 画像データ(図)だけを認識して消すにはどうすればよいのでしょうか? Sub sakujo() Dim Myshape As Shape For Each Myshape In ActiveSheet.Shapes If Myshape.Type <> msoFormControl Then Myshape.Delete End If Next End Sub

  • VBAについて教えてください。

    VBAについて質問です。 シート1(元払)があり、そのシート内のオートシェイプを消す式が下記の式で 可能なのですが、別シートのオートシェイプも同時に消す場合はどのようにすれば良いか 教えてください。   Sheets("元払").Select Dim sh As Shape For Each sh In ActiveSheet.Shapes If sh.Type = msoAutoShape Then sh.Delete End If Next sh

  • エクセルVBA オートシェイプを操作したいです

    エクセルでセルの入力内容によって楕円をオートシェイプで出現させたいと思います。 http://oshiete1.goo.ne.jp/qa809742.htmlで見つかったものを参考にし、 Private Sub worksheet_Activate() Dim Shp As Shape Set P11 = Range("P11") If P11 Is Nothing Then Exit Sub If P11.Value = 1 Then For Each Shp In ActiveSheet.Shapes If Not Application.Intersect(Shp.TopLeftCell, _ Range("N14:N15")) Is Nothing Then Shp.Delete End If Next Shp With ActiveSheet.Range("N14:N15") ActiveSheet.Shapes.AddShape(Type:=msoShapeOval, _ Left:=.Left,TOP:=.TOP,Width:=.Width,Height:=.Height).Select Selection.ShapeRange.Fill.Visible = msoFalse End With Range("N14").Select Else For Each Shp In ActiveSheet.Shapes If Not Application.Intersect(Shp.TopLeftCell, _ Range("N14:N15")) Is Nothing Then Shp.Delete End If Next Shp End If If P11.Value = 2 Then For Each Shp In ActiveSheet.Shapes If Not Application.Intersect(Shp.TopLeftCell, _ Range("N16")) Is Nothing Then Shp.Delete End If Next Shp With ActiveSheet.Range("N16") ActiveSheet.Shapes.AddShape(Type:=msoShapeOval, _ Left:=.Left, TOP:=.TOP, Width:=.Width, Height:=.Height).Select Selection.ShapeRange.Fill.Visible = msoFalse End With Range("N16").Select Else For Each Shp In ActiveSheet.Shapes If Not Application.Intersect(Shp.TopLeftCell, _ Range("N16")) Is Nothing Then Shp.Delete End If Next Shp End If End Sub とつなげて見ました。 動くには動くのですが、データ元のセルがP11からT30と100セルあり、さらにP11に入力されるデータが1,2,3,4の4種類、AQ11に5,6,7,8,9の5種類などと、ばらばらです。 P11に1が入力されるとN14:N15(結合されています)に円が入り、2が入力されるとN16に円が入る。 Q11に5が入力されるとR13に円が入り、6が入力されるとR14:R15に円が入る・・・・のようにしたいのです。 一生懸命、セルNo.を打ち込んでいたら、 「コンパイルエラー:プロシージャが大きすぎます」とエラーが出てしまいました。 ループさせればよいのだろうと試してみたのですが、元のセルの指定方法や、オートシェイプの出現させるせるの指定方法がわかりません。 どのようにすれば、データー元の範囲を指定して、それに対応したセルにオートシェイプを出現させる事が出来るようになるでしょうか。 お知恵を貸していただけないでしょうか。よろしくお願い致します。

  • EXCEL VBA これであっていますか?

    エクセルに地図を貼り付け、その中のある地点Aから半径1キロ、2キロ、3キロといった具合に円を描いています。ある地点B、Cも同様に円があります。セルに“A” と入力した際に該当する地点の円(1キロ、2キロ、3キロの3種類)を赤く表示し、終了すると円が消える(線なしに変わる)ようにするために以下のようなVBAを組みました。が、円が2つしか赤くならなかったり、 ばあいによっては「インデックスが境界を超えています」とエラーが出たりします。 どうしたら良いか教えてください。 Sub iro() Dim i As Variant i = InputBox("表示する地点を指定してください", "地点指定") If i = "A" Then ActiveSheet.Shapes(1).Select ActiveSheet.Shapes(2).Select ActiveSheet.Shapes(3).Select Replace:=False hyoji MsgBox "表示を終了してよろしいですか", vbOKOnly ActiveSheet.Shapes(1).Select ActiveSheet.Shapes(2).Select ActiveSheet.Shapes(3).Select Replace:=False modosu ElseIf i = "B" Then ActiveSheet.Shapes(4).Select ActiveSheet.Shapes(5).Select ActiveSheet.Shapes(6).Select Replace:=False hyoji MsgBox "表示を終了してよろしいですか", vbOKOnly ActiveSheet.Shapes(4).Select ActiveSheet.Shapes(5).Select ActiveSheet.Shapes(6).Select Replace:=False Else MsgBox "指定した地点がありません", vbOKOnly End If End Sub Sub hyoji() Selection.ShapeRange.Line.Visible = msoTrue '「線なし」に設定されている場合、線を表示 Selection.ShapeRange.Line.ForeColor.SchemeColor = 10 Range("A1").Select End Sub Sub modosu() Selection.ShapeRange.Line.Visible = msoFalse '「線なし」に設定 Range("A1").Select End Sub

  • エクセルVBAの線オブジェクト一括選択法

    エクセル2000VBAの初心者です。よろしくお願いいたします。 QNo.2268830に対するhana-hana3さんの回答にあった参照リンクに、 >●オートシェイプの円形の図だけを選択するには? >アクティブシートのオートシェイプで円形の図だけを選択する例です。 >Sub 円形のオートシェイプを全て選択() > Dim C As Shape > For Each C In ActiveSheet.Shapes >  If C.AutoShapeType = msoShapeOval Then C.Select False > Next C >End Sub がありました。これで、円形(msoShapeOval)や四角形(msoShapeRectangle)はうまく選択することが出来たのですが、オートシェイプで描いた線(AddLineで)を選択することが出来ません。 上記プログラムで、msoShapeOvalをLineに変えたり、いろいろしてみたのですが、分かりません。 どなたがご教授いただければ助かります。

  • VBA オートシェイブや図を選択したいのですが

    VBAでシート上にある全てのオートシェイブや図を選択したいのですが どのようにすればいいでしょうか? 手作業でなら、CTRL+Gでオブジェクトを選択すればできますがVBAで行いたいです。 Sub test() Dim s As Shape For Each s In ActiveSheet.Shapes s.Select Next End Sub をしても、一つずつしか選択できません。 全てを選択状態にしたいです。

  • VBA 図形の削除

    以下のようなコードにおいて、図名を指定するのではなく、図の種類を指定して削除したいのです。 テキストボックスを消す グラフを消す オートシェイプを消す などなど、オブジェクトの種類を指定して消すようにしたいのですが、どうすれば良いですか? Sub 指定図形削除()  図名=”削除したい図形名”  For Each zu In ActiveSheet.Shapes   If zu.Name = 図名 Then    zu.Delete    Exit For   End If  Next End Sub

  • エクセルVBAの構文についての質問です

    ちょっと前から勉強しはじめた超超初心者なんですが、オブジェクトやプロパティといった概念がちょっと理解できないでくるしんでいます 1、 Sub 図形非表示() ActiveSheet.Shapes("図形").Visible=False End Sub これは本にのっていた例文でアクテブシートの「図形」という名前のオートシェイプを非表示にする文なのですが本には「Visible プロパティ」 「Shapes プロパティ オートシェイプを返します」とありますがこれはつまり「Shapesプロパティ自体がオブジェクトになっている」ということなのでしょうか?「Shapes プロパティ」とかいてあるのでただのプロパティなのではないか???とおもってしまうのですが・・・ 2、 1と同じ感じなのですが Sub ワークシートに色を設定()   Worksheets("メニュー").Cells.Interior.ColorIndex=11 End Sub もInteriorプロパティ自体がオブジェクトになっているのでしょうか?? だとしたら全てのプロパティもオブジェクトになれるのでしょうか? 是非どなたか教えてください、よろしくお願いします

  • エクセルVBAでLineの一括処理

    ワークシート上に配置した複数のオートシェープの線(Lines)に対し、一括して太さと色を変えるにはどのようなコードになるのでしょうか? 勿論以下のTEST01のように名前で指定すれば可能なのですが、TEST02のような全てのLineということはできないのでしょうか? Sub Test01() With ActiveSheet.Shapes.Range(Array("Line 259", "Line 260")) .line.Weight = 1.75 .line.ForeColor.SchemeColor = 13 End With End Sub ↓実行時エラーとなる Sub Test02() With ActiveSheet.Lines .line.Weight = 2.5 .line.ForeColor.SchemeColor = 10 End With End Sub

  • エクセルVBAで画像を貼り付ける座標設定方法は?

    Sheets("Sheet1")に貼り付けたJ-pegの画像(=シンボルマーク)を別なシートに貼り付けるのは下記のVBAで出来ました。ただ、これでは貼り付け先のシートのセルK12が、貼り付け元のK12と同じ位置でないと思った場所に張り付きません。 そこでセルで場所を指定するのではなく、座標のようなもので指定する方法はないものかと考えた次第です。 オートシェイプなどは座標指定で作成できるのですが、J-pegのような画像はどうすればいいのでしょうか? Sub TEST() Sheets("FACE").Shapes("シンボルマーク").Copy ActiveSheet.Range("K12").Select ActiveSheet.Paste End Sub