• ベストアンサー

VBAですべての図形を消したい

お世話になります。 エクセルにて矢印等の図形をすべて選択し消去するにはどのようにコードを書けばよろしいですか。 ActiveSheet.Shapes.Range(Array("Line 1", "Line 2")).Select Selection.Delete これだと図形番号をすべて書かなくてはならないですね。 Range()内を現在表示されてる図形全部という書き方は?

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

  • ベストアンサー
  • imogasi
  • ベストアンサー率27% (4737/17068)
回答No.1

下記を実行してみてください。 全て消えて、消え過ぎになるかな。 コピーをとってテストしてください。 線と四角と楕円を各1つ貼りつけて実行すると消えました。 Sub test01() Worksheets("sheet1").DrawingObjects.Delete End Sub 

fukuchan72
質問者

お礼

さっそくのご回答有り難うございます。 どうしたら良いか分からずに悩み続けていました、 やっぱり教えてgooに聞いて良かったです。 imogasiさん有り難う御座いました。

関連するQ&A

  • 図形 Selectionが省略できない VBA

    「タイトル」という名の図形はシート上に存在するのですが、 Sub a() ActiveSheet.Shapes.Range(Array("タイトル")).ShapeRange.Height = 110 End Sub Sub b() ActiveSheet.Shapes.Range(Array("タイトル")).Select Selection.ShapeRange.Height = 110 End Sub aだとエラーになりますが、 bだと正常に動きます。 SelectやSelectionは省略できるものだと思ってるのですが なぜaだとエラーになるのでしょうか? 一度図形をアクティブにする動作が必要なのですか?

  • エクセル VBA 画像操作

    VBAについて質問です。 画像を何枚かを重ねて、シート上に置いてあります。 VLOOKUPにて、画像番号を獲得して、その番号の画像を最上面へ移動させたいのですが ActiveSheet.Shapes.Range(Array("Picture 201")).Select ActiveWindow.SmallScroll ToRight:=-342 Selection.ShapeRange.ZOrder msoBringToFront ActiveSheet.Shapes.Range(Array("Picture 221")).Select ActiveWindow.SmallScroll ToRight:=-342 Selection.ShapeRange.ZOrder msoBringToFront ActiveSheet.Shapes.Range(Array("Picture 215")).Select ActiveWindow.SmallScroll ToRight:=-342 Selection.ShapeRange.ZOrder msoBringToFront ("Picture 215")の部分を、セルの値で変更したいのですが どうか、お力お貸しください。 よろしくお願いします。

  • やはり図形のクリアで実行時エラー1004

     図形を二行三列で一枡とし図形を貼り付けていますが、どうしても実行時エラー 「1004」が出て図形のクリアができません。(尚、四角形は枠線上にあります。) 対処法がありましたらお願いします。 Windows7・SP1 Office2010 Sub 図形の貼付け() Dim i As Integer Dim j As Integer For i = 10 To 43 Step 2 For j = 9 To 99 Step 3 Select Case Cells(i, j).Value Case 1: ActiveSheet.Shapes("四角形1").Select Selection.Copy Cells(i + 1, j + 1).Select ActiveSheet.Paste Case 2: ActiveSheet.Shapes("四角形2").Select Selection.Copy Cells(i + 1, j).Select ActiveSheet.Paste Case 4: ActiveSheet.Shapes("四角形3").Select Selection.Copy Cells(i + 1, j + 1).Select ActiveSheet.Paste Case 5: ActiveSheet.Shapes("四角形3").Select Selection.Copy Cells(i + 1, j + 2).Select ActiveSheet.Paste Case 6: ActiveSheet.Shapes("円1").Select Selection.Copy Cells(i, j).Select ActiveSheet.Paste End Select Next Next End Select End Sub Sub 図形のクリア() Dim myRng As Range Set myRng = Range("I10:CW43") Dim n As Integer, sp As Variant For n = ActiveSheet.Shapes.Count To 1 Step -1 Set sp = ActiveSheet.Shapes(n) If Not Intersect(Range(sp.TopLeftCell, sp.BottomRightCell), myRng) Is Nothing  (ここで実行時エラー1004になります。) Then sp.Delete End If Next Set myRng = Nothing End Sub

  • VBAのGroup化について

    お世話になります。以下のマクロがうまく動きません。 ------------------------------------------------- Dim objShp1 As Shape For Each objShp1 In ActiveSheet.Shapes If objShp1.Name = "Picture 3" Then ActiveSheet.Shapes.Range(Array("A", "B", "Picture 3")).Select Selection.ShapeRange.Group.Select Selection.ShapeRange.ThreeD.RotationX = -180 Selection.ShapeRange.IncrementLeft 0 Selection.ShapeRange.IncrementTop 0 Else ActiveSheet.Shapes.Range(Array("A", "B")).Select Selection.ShapeRange.Group.Select <---------(1) Selection.ShapeRange.ThreeD.RotationX = -180 Selection.ShapeRange.IncrementLeft 0 Selection.ShapeRange.IncrementTop 0 End If Next ------------------------------------------------- このマクロは全体の一部分になりますが、(1)のところでエラーになります。 どこが間違っているのか、さっぱりわかりません。 すみませんが、お助けいただければ幸いです。

  • 描画した Line 番号の取得方法

    描画した Line 番号の取得方法 VB6 Excel,2000 線をVBで2本引き、その線をグループ化させようと考えています。 下記コードの Range(Array("LIne " & 線A, "LIne " & 線B))に 2本引いた線の番号を入れたいのですが引いた線のLine番号を 取得する方法が分かりません、宜しくお願いします。 Dim xlApp As Excel.Application Set xlApp = GetObject(, "Excel.Application") xlApp.ActiveSheet.Shapes.AddLine 50, 50, 100, 100 '線A xlApp.ActiveSheet.Shapes.AddLine 100, 50, 50, 100 '線B xlApp.ActiveSheet.Shapes.Range(Array("LIne " & 線A, "LIne " & 線B)).Select xlApp.Selection.ShapeRange.Group.Select Set xlApp = Nothing

  • Excel 2010 で勤務割表を作成しています。

    月間の勤務割表を作成しています。 3列3行を一枡として一人・一日の枡とし、勤務の割り振り状態を表示するものです。 列に日付、行を個人名(max16名)としますから、3列3行の枡が496個となります。 各枡とも1列目の1行目に勤務種別コード(1~5)を記述し、このコードNoにより4種の図形を貼付けています。 1つ1つの枡(496個)に以下のコードを書き実行しています。膨大な行数を要します。 使用するパソコンにおいては実行速度がかなりかかります。 これをもっと単純化する手法についてご教示いただければ幸いです。 Sub Macro1() Select Case Range("I6").Value '1人目-1日 Case 1: ActiveSheet.Shapes("四角形1").Select Selection.Copy Range("J7").Select ActiveSheet.Paste Case 2: ActiveSheet.Shapes("四角形2").Select Selection.Copy Range("I7").Select ActiveSheet.Paste Case 3: ActiveSheet.Shapes("四角形3").Select Selection.Copy Range("J7").Select ActiveSheet.Paste Case 4: ActiveSheet.Shapes("直線1").Select Selection.Copy Range("I6").Select ActiveSheet.Paste Case 9: ActiveSheet.Shapes("四角形3").Select Selection.Copy Range("J7").Select ActiveSheet.Paste End Select  '|   '| <同じことを一つ一つの枡ごとに繰り返し記述しています。>   '| Select Case Range("CU51").Value '16人目-31日 Case 1: ActiveSheet.Shapes("四角形1").Select Selection.Copy Range("CV52").Select ActiveSheet.Paste Case 2: ActiveSheet.Shapes("四角形2").Select Selection.Copy Range("CU52").Select ActiveSheet.Paste Case 3: ActiveSheet.Shapes("四角形3").Select Selection.Copy Range("CV52").Select ActiveSheet.Paste Case 4: ActiveSheet.Shapes("直線1").Select Selection.Copy Range("CU51").Select ActiveSheet.Paste Case 9: ActiveSheet.Shapes("四角形3").Select Selection.Copy Range("CV52").Select ActiveSheet.Paste End Select End Sub

  • VBA のAddlineで引いた線を削除したい。

    Chart上にAddlineした直線が消せません。 あるイベントで ActiveChart.Shapes.AddLine(Xp1, Yline, Xp2, Yline).Select Selection.ShapeRange.Line.DashStyle = msoLineDash Selection.Name = "SUB_LINE" この時Chart上にはラインが引かれ名称が付けられています 又違うイベントで ActiveSheet.Shapes("SUB_LINE").Selectや Shapes("SUB_LINE").Delete として先ほど引いたLineを消去したいのですが Deleteの結果特にエラーも出ず、削除できません ツールを使って書いたLineは For Each SerchCShp In ActiveSheet.Shapes next の中で削除できたりするのですが 同じようにコーディングしても消えてくれません。  AddlineでChartに書き込んだLineを消去する方法を 教えてください。 Chartの補助線等は別の機能で使用しているので 使えずAddlineで線を引くしかないと言う状況で 引いた線を消したいのは引きなおしさせるためです WindowsXp+Office2003のExcel VBAを使用しています。

  • エクセルVBAで複数の図に名前をつけたい

    エクセルVBAで複数の図に名前をつけたい エクセルで見出しと合計2カ所などウィンドウ枠固定を複数つける ことはできないので、かわる方法として図のリンク貼り付けを利用 しようと思い下記を作りました。 Sub test()   Range("A100", "R100").Select   Selection.Copy   Range("A1").Select   ActiveSheet.Pictures.Paste link:=True   ActiveSheet.Pictures.ShapeRange.Name = "合計1"   Range("A200", "R200").Select   Selection.Copy   Range("A2").Select   ActiveSheet.Pictures.Paste link:=True   ActiveSheet.Pictures.ShapeRange.Name = "合計2" ・・・(1) End Sub 必要に応じて合計1または合計2を削除します Sub 図1削除() ActiveSheet.Shapes("合計1").Delete End Sub Sub 図2削除() ActiveSheet.Shapes("合計2").Delete End Sub (1)のところで 「このメンバにアクセスできるのは、単一の図形の場合だけです」エラーになります。 エラーがでないように図に名前をつける方法をおしえていただけないでしょうか。 何卒よろしくお願い致します

  • エクセル VBA : テキストボックスのグループ化

    エクセル VBAにてテキストボックスをグループ化したいのです。 マクロを記録すると、 ActiveSheet.Shapes.Range(Array("Oval 82", "Text Box 83")).Select Selection.ShapeRange.Group.Select となります。 "Text Box 83"のように常に名前が固定されているわけではないので、セルのA1からC10にある図形を選択してグループ化するようにしたいのです。 ご存知の方、アドバイス願います。

  • エクセルVBA-カウンター i と j の使い方

    2つの条件を同時に満たすと図形を別のワークシートにコピーし、600行程度あるワークシートなので For - Next を使ってその作業を繰り返す、というエクセルのマクロを以下のように書き込みました。ところがマクロを実行すると、一番最初の行だけ正確に実行され、次に条件を満たす行があっても図形がコピーされません。(ということはカウンター i, j の使い方が間違っているのです)どなたか私の素人コードを見て修正方法を教えてください。お願いします。 Sub finalize() Dim MyStr As String Dim i As Long Dim j As Long  For j = 2 To 1482 Step 40 For i = 3 To 188 Step 5 MyStr = Range("O" & i) If MyStr <> "" Then                    '条件1 If Range("L" & i).Value = "毎日" Then      '条件2   Sheets("図形_現読").Select ActiveSheet.Shapes.Range(Array("毎日")).Select Selection.Copy Sheets("印刷画面").Select Range("AG" & j).Select ActiveSheet.Paste Else If Range("L" & i).Value = "朝刊" Then Sheets("図形_現読").Select ActiveSheet.Shapes.Range(Array("朝刊")).Select Selection.Copy Sheets("印刷画面").Select Range("AG" & j).Select ActiveSheet.Paste End If End If End If Next i Next j End Sub

専門家に質問してみよう