• ベストアンサー

エクセルVBAで指定範囲内のオートシェープを選択

エクセル2000です。 仮にワークシートのRange("A1:B5")の範囲の中に貼り付けられたオートシェープの直線をまとめて選択する場合にはどのように書けばいいのでしょうか? Sub TEST() Application.Intersect(Range("A1:B5"), ActiveSheet.Lines).Select End Sub とやってみましたが、エラーでした。 どうぞよろしくお願いします。

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

  • ベストアンサー
noname#29107
noname#29107
回答No.2

#1です。 >範囲にこだわらず、Line 1~100までを同時選択はできない >ものでしょうか? Sub test2() On Error Resume Next For i = 1 To 100   Sheets("Sheet1").Shapes("Line " & i).Select (False) Next End Sub

AQUALINE
質問者

お礼

なんと! Select(False)でこんなことができるんですね! 目からうろこです。 ありがとうございました!

その他の回答 (2)

  • ja7awu
  • ベストアンサー率62% (292/464)
回答No.3

線の左上端が、セルA1:B5の範囲内にあるものだけを選択状態にするには、 こんな感じで如何でしょうか。 Sub Macro1() Dim L As Line Dim N As Integer For Each L In ActiveSheet.Lines   If Not Intersect(Range("A1:B5"), L.TopLeftCell) Is Nothing Then     If N = 0 Then       L.Select       N = N + 1     Else       L.Select (False)     End If   End If Next End Sub

AQUALINE
質問者

お礼

ありがとうございます。 やはりIntersectでも出来るんですね。 勉強になりました。

noname#29107
noname#29107
回答No.1

EXCEL2002で検証したので、動作しないかもしれません。 もっと簡単にできる方法が分かりませんでしたので、長いです。 >ワークシートのRange("A1:B5")の範囲の中 完全に範囲内に収まる直線と解釈しました。 Sub test1() ' Dim mySht As Worksheet, myRng As Range, myRng2 As Range, SlRng As Range '   Set mySht = Sheets("Sheet1")   Set SlRng = Range("A1:B5")   For i = 1 To mySht.Shapes.Count     Set myRng = mySht.Shapes(i).TopLeftCell     Set myRng2 = mySht.Shapes(i).BottomRightCell     If mySht.Shapes(i).Type = msoLine Then       If myRng.Column >= SlRng.Columns(1).Column _         And myRng.Column <= SlRng.Columns(SlRng.Columns.Count).Column _         And myRng.Row >= SlRng.Rows(1).Row _         And myRng.Row <= SlRng.Rows(SlRng.Rows.Count).Row _         And myRng2.Column >= SlRng.Columns(1).Column _         And myRng2.Column <= SlRng.Columns(SlRng.Columns.Count).Column _         And myRng2.Row >= SlRng.Rows(1).Row _         And myRng2.Row <= SlRng.Rows(SlRng.Rows.Count).Row Then         mySht.Shapes(i).Select (False)       End If     End If   Next End Sub

AQUALINE
質問者

お礼

さっそくありがとうございます。 できました。 これで今回はOKなのですが、かなり煩雑な式になるんですねえ。 考えたのですが、オートシェープの名前はわかっているので ActiveSheet.Shapes.Range(Array("Line 1", "Line 2", "Line 3")).Select のように、Arrayで選択もできるんです。 ただ、数が多くなって、たとえば"Line 100”までこう書くのもなんですよね。 範囲にこだわらず、Line 1~100までを同時選択はできないものでしょうか?

関連するQ&A

  • エクセルVBAオートシェイプがあったら、の書き方

    皆さんこんにちは。 エクセルVBAの初心者です。 IFを使った条件分岐が私には難しかったので SELECTCASEを用いてみようと思うのですが条件の書き方が分かりません。 やりたい事は セルA1が「文字が入っていない且つオートシェイプが入っていない場合」のみ アクション(オートシェイプ☆を貼る)を起こしたい、です。 イメージ的にこうなるかな?と思いコードを作成しましたが ケース2の「オートシェイプがあったら」という条件の書き方が分かりません。 Sub オートシェイプ貼り付け()   With ThisWorkbook.Worksheets("Sheet1")   Select Case True     Case .Range("A1").Value <> ""     Exit Sub     Case オートシェイプがあったら     Exit Sub     Case Else       オートシェイプ☆を貼る   End Select End Sub オートシェイプの有無を条件にするにはどのような書き方をすれば良いでしょうか?

  • エクセル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.を打ち込んでいたら、 「コンパイルエラー:プロシージャが大きすぎます」とエラーが出てしまいました。 ループさせればよいのだろうと試してみたのですが、元のセルの指定方法や、オートシェイプの出現させるせるの指定方法がわかりません。 どのようにすれば、データー元の範囲を指定して、それに対応したセルにオートシェイプを出現させる事が出来るようになるでしょうか。 お知恵を貸していただけないでしょうか。よろしくお願い致します。

  • エクセルVBAでオートシェープのRectangleの選択

    しょうもない質問ですが、不思議なので教えてください。 エクセル2000です。 ワークシート上に配置したオートシェープのTypeNameを取得してみると、線(Line)、楕円(Oval)以外は四角形も八角形も星型もみんなRectangleでした。 ところが、 ActiveSheet.Rectangles.Select としてみても、選択されるのは四角形と丸四角形のみです。 もちろん、Lines.Select や、Ovals.Select で選択できるのは、線 と 楕円 だけです。 八角形も星型もみんなTypeNameはRectangleなのに四角形と丸四角形以外のRectangleはどうして選択できないのでしょうか? Sub testRectangle() For Each o In ActiveSheet.DrawingObjects If TypeName(o) = "Rectangle" Then o.Select (False) Next End Sub とやれば、Rectangleだけ選択は出来ますが、ループしないで一括で選択はできないのでしょうか?

  • VBAでオートシェイプの制御?

    エクセルマクロでセルにオートシェイプを張る方法を調べていて、ここで丁度いいのを見つけました。 http://oshiete1.goo.ne.jp/kotaeru.php3?q=808898 見つけた下記のマクロを実際にやってみました。 A1に1を入れるとB2にハートマークが出ます。 しかし、さらに2を入力してもB2のハートは削除されてくれません。 さらに1をいれると、ハートの上にハートが重なってしまいます。 1ならハート、それ以外の入力ならハートが消えるようにするにはどうすればいいのでしょうか? Private Sub Worksheet_Change(ByVal Target As Range) If Target <> Range("A1") Then Exit Sub If Target.Value = 1 Then With ActiveSheet.Range("B2") ActiveSheet.Shapes.AddShape(Type:=msoShapeHeart, _ Left:=.Left, Top:=.Top, Width:=.Width, Height:=.Height).Select End With End If End Sub

  • 指定範囲のオートシェイプの削除

    範囲指定した箇所のオートシェイプを削除したく、WEBで見つけた物に手を加えてみました。しかし、実行されるとシート内全てのオートシェイプが削除されてしまいます。 今削除したいのは、Range("B21:AA22")範囲内のものだけです。 正直なところ大半の意味も判らないまま触っているので、問題箇所の検討が付きません。 どの部分を修正するばいいのでしょうか? また、何故ダメなのかも合せてご教示いただけたら幸いです。 宜しくお願い致します。 Dim myShp As Shape Dim myR As Range, SR As Range On Error Resume Next Set myR = Range("B21:AA22") If Err.Number <> 0 Then Exit Sub On Error GoTo 0 For Each myShp In ActiveSheet.Shapes Set SR = Range("B21:AA22") If Not Intersect(SR, myR) Is Nothing Then myShp.Delete End If Set SR = Nothing Next Set myR = Nothing

  • エクセルVBAでの複数のオートシェイプの色塗り方法

    ネットから下記のコードを見つけたのですが、1つのシートに複数のオートシェイプの色塗りを変更する方法を教えてください。 例えばセル"A1"には数値の1と"A2"には数値2を入力したら、 オートシェイプAにはセル"A1"に対応した色塗り『赤色』を オートシェイプBにはセル"A2"に対応した色塗り『黄色』といった感じです。 下記のコードをいくつも繋げれば、複数のオートシェイプの色塗りが出来ると思ったのですが、コードを繋げる方法がわかりません。その他に何か良い方法がありましたら教えてください。 Private Sub Worksheet_Change(ByVal Target As Range) If Target.Address(0, 0) <> "A1" Then Exit Sub With ActiveSheet.Shapes("ABC").Fill.ForeColor Select Case Target.Value Case Is = "赤" .SchemeColor = 2 Case Is = "黄" .SchemeColor = 5 Case Is = "緑" .SchemeColor = 3 Case Is = "青" .SchemeColor = 4 Case Else .SchemeColor = 1 End Select End With End Sub

  • エクセル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 シートの選択 

    windows XP でエクセル2000を使っています。 Sub aaa() Sheets("Sheet1").Select Dim a As String a = Cells(2, 4) Sheets(a).Select Range("A1").Select End Sub というマクロだと セルに入っている値のシート名を探してくれます。 ですが Private Sub Worksheet_SelectionChange(ByVal Target As Excel.Range) If Intersect(Target, Range("B11:b683")) Is Nothing Then Exit Sub Worksheets("Sheet1").Range("C2").Value = Target.Value Dim b As String b = Range("C2).value (←ここをcellsにしてもダメ) Sheets(b).Select Range("A1").Select End Sub これだとsheets(b)を選びません。Sheets(b).Selectのところが黄色くなります。 何処が間違えているのでしょうか。 全くの素人ですが、仕事で必要に迫られています。 わかりやすく回答・解説くれると助かります。

  • エクセル VBA 選択範囲書込?

    エクセルのVBAで Activesheet Range("A1:B2").Selectは Activesheet Cells(???????).Selectでは どのように書き込めば宜しいのでしょうか?

  • エクセルVBAで5行目からオートフィルタモードに設定したいたい

    抽出項目が5行目にあり、オートフィルタを5行目から表示させたいのですが、うまくいきません。 Macro1では項目が消えてしまい、▼が1行目に、Macro2では項目は残りますが、▼は同じく1行目になってしまいます。どうしたら5行目にオートシェイプの▼が配置できるでしょうか? Sub Macro1() Range("A5").Select Selection.AutoFilter End Sub Sub Macro2() Range("A5").AutoFilter End Sub

専門家に質問してみよう