• ベストアンサー

エクセルVBAでAutoShape削除

シートからオートシェープの星型と線を削除するためのマクロですが、以下でうまく行きます。 Sub SAKUJO() For Each s In ActiveSheet.Shapes If s.Type = msoLine Or s.AutoShapeType = msoShape5pointStar Then s.Delete Next End Sub 質問は、線と星型を他のオートシェープと選別するために、線は「Type」、星型は「AutoShapeType」と異なる選別方法を別々に指定しなければならないのかということです。そもそも「Type」と「AutoShapeType」は何が違うのでしょう? 両方を同じように「Type」か「AutoShapeType」あるいは他の方法で指定する方法はないのでしょうか?

質問者が選んだベストアンサー

  • ベストアンサー
  • KenKen_SP
  • ベストアンサー率62% (785/1258)
回答No.5

こんにちは。KenKen_SP です。 補足というより、蛇足コメントです、、、 Wendy02 さんご提示の通り、Name で識別するのが最も手っ取り 早そうですね。 一意の名前についてですが、このような場合次の方法がいいと思 います。 シェープをコードで書いた時点で既に Excel が一意の名前を付与 しています。後で処理し易くするために、その名前に接頭辞か 接尾辞を加えます。 With ActiveSheet.Shapes.AddShape _   (msoShape5pointStar, LP, TP, W, H)   .Name = "5pointStar_" & .Name End With この方法ですと、同名は発生しません。 これを再処理する場合は Shapes コレクションか DrawingObjects コレクションでループさせて Name プロパティの値を Like 演算子 で比較するか、InStr 関数を使います。 Like 演算子による方法は既に Wendy02 さんが示されてますので、 InStr 関数による方法です。 For Each shp In ActiveSheet.DrawingObjects   If InStr(1, shp.Name, "5pointStar_") > 0 Then     shp.Delete   End If Next shp ご参考までに。

merlionXX
質問者

お礼

いつもお世話様です。 > .Name = "5pointStar_" & .Name すばらしい! これなら連番の振り方でなやむ必要がなくなりました。 ありがとうございます。

その他の回答 (5)

  • Wendy02
  • ベストアンサー率57% (3570/6232)
回答No.6

merlionXX さん、KenKen_SP さん、こんにちは、Wendy02 です。 回答とは直接関係がありませんが、私は、自分のこの関連コードに関しては、未だ、解明できていないところがあります。解決せずに、ちょうど1年になろうとしています。 merlionXXさんは、お分かりになっていると思いますが、いわゆる、オートシェイプを量産して、削除してということを繰り返していくうちに、いわゆる、.name の「オブジェクト・ネーム」の枝番が、更新もされずに、インクリメンタルに増えていきますね。 その点で、私は、自分でオートシェイプを使ったコードに対して不安を覚えました。 仕事で毎日、私の作ったシートとコードで、オートシェイプの生成と削除を繰り返したら、年間では、1万では済まないはずで、通常使用で、最低1年間ぐらいのブックの安全が確保されるか、分からなくなりました。そこで、全面的にコードの内容を換えたことがあります。 それに比べて、シート名の枝番は、再起動すれば、更新されますね。また、自動記録マクロのMacro名も更新されます。開いたまま、Add-Deleteを繰り返さなければ、ほぼ大丈夫です。ですが、オートシェイプだけは出来ません。 削除して、再起動すれば、本当に、全部がクリアになっているならよいのですが、このように、何かが残っているとなると、果たして、Add-Delete を繰り返して、大丈夫かなっていうのが、私の懸案の問題です。 だから、オートシェイプは、使いまわし出来るなら、使いまわししていこう、というのが、現在の私のVBAにおいての考え方です。 まだ、解決には至っていません。 分かっているのは、 \ApplicationData\Microsoft\Office\Recent フォルダの .lnk ファイルには、それは存在していません。レジストリだとしたら、それも、まずいはずです。 #4 の'オートシェイプを作る のコードは、現れないようなことはありませんよね。ところが、繰り返しをすると、図形が現れなくなります。そこで、コードの最後に、Application.ScreenUpdating = True はいれないといけないのですが、何かがヘンだなって思います。 私のPC固有の現象かもしれませんが、他の方が、そうしたコードで図形が出ないといわれたことがありますので、それは間違いないと思っています。

merlionXX
質問者

お礼

補足に書いた件、新しい質問としてみます。 ありがとうございました。

merlionXX
質問者

補足

KenKen_SP さん、Wendy02 さん、おふたりには本当にいつもお世話になります。 > name の「オブジェクト・ネーム」の枝番が、更新もされずに、インクリメンタルに増えていきますね。 はい、じつはこれは次の質問にしようと思っていたんです。 どこまでも増えていくけど、大丈夫なんですか?って。 テスト用のコードも作ってあります。 現在、28000番まできていますが、いまのところ大丈夫です。 For n = 1 To 100 の数値を増やして、いっぺんに何万もやってみようかとも思いましたが、1000を超えると、極端に動きがおそくなり、やがて固まってしまいます。 Sub test() With Application .WindowState = xlMaximized .DisplayFormulaBar = False .Caption = "☆TEST中☆" End With With ActiveWindow .WindowState = xlMaximized .DisplayWorkbookTabs = False .DisplayGridlines = False .DisplayHeadings = False End With For Each myCB In Application.CommandBars myCB.Enabled = False Next myCB Randomize With ActiveSheet .Cells.Interior.ColorIndex = 1 CL = Int((50 * Rnd) + 1) L1 = Int((700 * Rnd) + 20) H1 = Int((450 * Rnd) + 20) Set SA = .Shapes.AddShape(msoShape5pointStar, L1, H1, 25, 25) SA.Name = "Merlion_" & SA.Name SA.Fill.ForeColor.SchemeColor = CL For n = 1 To 100 CL = Int((50 * Rnd) + 1) L2 = Int((650 * Rnd) + 20) H2 = Int((450 * Rnd) + 20) On Error GoTo line SA.Top = H2 - SA.Width / 2 SA.Left = L2 - SA.Height / 2 SA.Fill.ForeColor.SchemeColor = CL Set SL = .Shapes.AddLine(L1, H1, L2, H2) SL.Name = "Merlion_" & SL.Name Application.StatusBar = SL.Name SL.line.Weight = 0.75 SL.line.ForeColor.SchemeColor = CL L1 = L2 H1 = H2 Next SA.ZOrder msoBringToFront SA.line.Visible = True SA.line.ForeColor.SchemeColor = CL For i = 1 To 800 Step 60 SA.Rotation = i / 10 SA.line.Weight = i DoEvents Next line: For Each s In .Shapes If s.Name Like "Merlion_*" Then s.Delete Next .Cells.Interior.ColorIndex = xlNone End With With Application .DisplayFullScreen = False .DisplayFormulaBar = True .DisplayStatusBar = True .Caption = "" End With With ActiveWindow .DisplayWorkbookTabs = True .DisplayGridlines = True .DisplayHeadings = True End With For Each myCB In Application.CommandBars myCB.Enabled = True Next myCB End Sub

  • Wendy02
  • ベストアンサー率57% (3570/6232)
回答No.4

merlionXX さん、こんにちは。 一応、サンプルは提示しておきます。 # 星は、Regtangle Sub ShapesTypeName() Dim shp As Object For Each shp In ActiveSheet.DrawingObjects   MsgBox TypeName(shp) Next End Sub >一回の操作で何百個も図形が生成され、削除されるんです。だからいちいち一意の名前なんて付けられないんです。 'オートシェイプを作る Sub AddshapePrc() With ActiveCell   Lf = .Left: Tp = .Top: Ht = .Height   FirstLocation = 0.5 + Ht * 2   For i = 0 To 10    With ActiveSheet.Shapes.AddShape _     (msoShapeOval, FirstLocation + Lf, Ht * i + Tp, Ht, Ht)     .Line.ForeColor.SchemeColor = 10     .Visible = True     .Name = "Ov" & i + 1  'ここの部分    End With   Next  End With End Sub '削除方法 Sub DelshapePrc() For Each shp In ActiveSheet.Shapes   If shp.Name Like "Ov*" Then     shp.Delete   End If Next End Sub

merlionXX
質問者

お礼

お礼がおそくなり、すみません。 なるほど~っ!! .Name = "Ov" & i + 1  ですかあ。 これならいくつでも名前が付けられますね。 ありがとうございました。

  • Wendy02
  • ベストアンサー率57% (3570/6232)
回答No.3

merlionXXさん、こんにちは。 すみません。あまり、私は、星などは、使ったことがなかったので、出来ると思い込んでいました。先ほど、TypeName でもとってみたのですが、星は、Rectangle でした。 そうすると、既存のものに対しては、AutoShapeType の組み込み定数以外にはなさそうですね。 逆にいうと、私の実際のコードでは、先に、オートシェイプを作る際に、オートシェイプの名前に一意の名前をつけています。そうすれば、見失うことがありませんから。

merlionXX
質問者

お礼

> オートシェイプの名前に一意の名前をつけています。 ありがとうございます。 でもうごきの激しいのを作っているので、一回の操作で何百個も図形が生成され、削除されるんです。だからいちいち一意の名前なんて付けられないんです。

merlionXX
質問者

補足

何度もありがとうございます。 そうですよね、ふつうVBAで星型なんて使いませんよね(笑) TypeNameでとる? Cells(n, "G").Value = TypeName(S)とやってみたら、すべて「Shape」でしたが、どうやって取得したのでしょうか? > 星は、Rectangle ええっ?!Rectangleって四角形って意味ですよ?!

  • Wendy02
  • ベストアンサー率57% (3570/6232)
回答No.2

こんにちは。 >そもそも「Type」と「AutoShapeType」は何が違うのでしょう? >両方を同じように「Type」か「AutoShapeType」あるいは他の方法で指定する方法はないのでしょうか? 私の経歴はそんなに長くないのですが、AutoShape自体が、時代を経て、コレクション化したのではないでしょうか? Type で取れる「MsoShapeType」クラスのというのは、AutoShape、Chart、Comment、OLEObject, FormControl などに、Lineもあって、もともと別な存在だったわけです。 それを統合して、AutoShape にしたのであって、上記のAutoShape の個別のAutoShape コレクションは、図形のひとまとめにしたもので、その中に、AutoShapeType があります。 別の方法といっても、DrawingObjectのShapeRange では、同じように、TypeとAutoShapeType とになるので、同じことです。だから、おなじ プロパティで選別する方法は、プロパティの name をLike で取る以外は、ないのではないかと思います。name は、Object名として、マクロ以外には変更は出来ませんから、ある程度は、有効だ思います。

merlionXX
質問者

お礼

Wendy02さん、いつもお世話様です。 くだらない質問ですみません。

merlionXX
質問者

補足

Nameで区別できればいいと思い、以下のマクロでNameを取得してみました。 Sub s_name() n = 5 For Each s In ActiveSheet.Shapes n = n + 1 Cells(n, "D").Value = s.Name Cells(n, "E").Value = s.Type Cells(n, "F").Value = s.AutoShapeType Next End Sub ところが、これでは線は「Line ###」、ワードアートは「WordArt ###」、フォームからの挿入のものは「Check Box ###」、「Option Button ###」と区別できるのですが、図形は星型も月型もハート型もみな「AutoShape ###」で区別がつかないんです。(四角形は「Rectangle ###」、円弧は「Arc ###」、楕円は「Oval "###」で区別できたのですが、それ以外はみな「AutoShape ###」です。)

  • 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のようです。