- 締切済み
エクセル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だけ選択は出来ますが、ループしないで一括で選択はできないのでしょうか？
- merlionXX
- お礼率93% (1499/1605)
- オフィス系ソフト
- 回答数1
- ありがとう数7
- みんなの回答 （1）
- 専門家の回答
みんなの回答
- fly_moon
- ベストアンサー率20% (213/1046)
Shapesオブジェクトの利用はダメなのでしょうか？ Sub testRectangle() ActiveSheet.Shapes.SelectAll End Sub ですべてのオートシェイプが一括選択できるんじゃないでしょうか。 Sub testRectangle_5pointstar() Dim o As Shape For Each o In ActiveSheet.Shapes If o.AutoShapeType = 92 Then o.Select (False) Next End Sub で５点の星型のみ選択ですが、これはループしないと出来ないような気がします。オブジェクトブラウザで"msoShape*"を検索したら92以外の図形の定数がわかります。
関連するQ&A
- エクセルＶＢＡで指定範囲内のオートシェープを選択
エクセル２０００です。 仮にワークシートのRange("A1:B5")の範囲の中に貼り付けられたオートシェープの直線をまとめて選択する場合にはどのように書けばいいのでしょうか？ Sub TEST() Application.Intersect(Range("A1:B5"), ActiveSheet.Lines).Select End Sub とやってみましたが、エラーでした。 どうぞよろしくお願いします。
- ベストアンサー
- オフィス系ソフト
- エクセルVBAでもっとすっきりさせたい
エクセル2000です。 ワークシート上にオートシェープの楕円を５個配置してあります。 それぞれ名前をOval_1～Oval_5と設定しました。 それぞれは以下のマクロを組み込み、クリックにより破線、実線と変更します。実線が選択されたしるしとします。 Oval_1～Oval_3で１グループ、Oval_4～Oval_5で１グループとし、それぞれのグループ内で1個の楕円しか選べないようにしたいのです。 一応、希望通りの動きはするのですが、何かすっきりしません。 もっと気の利いたコードはないでしょうか？ Sub Oval_Check() With ActiveSheet If .Shapes(Application.Caller).Line.DashStyle = msoLineSolid Then 'クリックしたのが実線なら .Shapes(Application.Caller).Line.DashStyle = msoLineSquareDot ' 破線に Select Case Application.Caller 'クリックしたのが Case "Oval_4" 'Oval_4なら .Shapes("Oval_5").Line.DashStyle = msoLineSolid 'Oval_5を実線に Case "Oval_5" 'Oval_5なら .Shapes("Oval_4").Line.DashStyle = msoLineSolid 'Oval_4を実線に End Select Else 'そうでないなら .Shapes(Application.Caller).Line.DashStyle = msoLineSolid ' 実線に Select Case Application.Caller 'クリックしたのが Case "Oval_1" 'Oval_1なら .Shapes.Range(Array("Oval_2", "Oval_3")).Line.DashStyle = msoLineSquareDot 'Oval_2,Oval_3を破線に Case "Oval_2" 'Oval_2なら .Shapes.Range(Array("Oval_1", "Oval_3")).Line.DashStyle = msoLineSquareDot 'Oval_1,Oval_3を破線に Case "Oval_3" 'Oval_3なら .Shapes.Range(Array("Oval_1", "Oval_2")).Line.DashStyle = msoLineSquareDot 'Oval_1,Oval_2を破線に Case "Oval_4" 'Oval_4なら .Shapes("Oval_5").Line.DashStyle = msoLineSquareDot 'Oval_5を破線に Case "Oval_5" 'Oval_5なら .Shapes("Oval_4").Line.DashStyle = msoLineSquareDot 'Oval_4を破線に End Select End If End With End Sub
- ベストアンサー
- オフィス系ソフト
- エクセルVBAでオートシェープを円く動かしたい。
星型をシート上で回転しながらぐるっと円周のように動かそうと、ためしに下記のマクロを書きましたが、やはり方向転換がぎこちなく、スムーズな丸い動きにはなりません。 かと言って、上下左右以外に動かす方法はないでしょうし、何かいいやり方はないでしょうか？ Sub Star() With ActiveSheet.Shapes.AddShape(msoShape5pointStar, 273#, 43#, 50#, 50#) .Fill.ForeColor.SchemeColor = 13 .Line.Weight = 0.75 .Line.ForeColor.SchemeColor = 64 For i = 1 To 180 a = 1 b = 1 If i > 90 Then a = -1 If i < 45 Or i > 135 Then b = -1 .IncrementRotation 2 .IncrementTop 2 * a .IncrementLeft -2 * b DoEvents Next End With End Sub
- ベストアンサー
- オフィス系ソフト
- EXCEL VBA これであっていますか？
エクセルに地図を貼り付け、その中のある地点Aから半径１キロ、２キロ、３キロといった具合に円を描いています。ある地点B、Cも同様に円があります。セルに“A” と入力した際に該当する地点の円（１キロ、２キロ、３キロの3種類）を赤く表示し、終了すると円が消える（線なしに変わる）ようにするために以下のようなＶＢＡを組みました。が、円が２つしか赤くならなかったり、 ばあいによっては「インデックスが境界を超えています」とエラーが出たりします。 どうしたら良いか教えてください。 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
- ベストアンサー
- オフィス系ソフト
- Excel2003で簡単な図形の表示と非表示のプログラムを作成したので
Excel2003で簡単な図形の表示と非表示のプログラムを作成したのですが上手く出来ません UserForm1に Private Sub OptionButton1 Click() ActiveSheet.Shapes("Oval 1").Visible=True 'ワークシート１に楕円の図形１表示 ActiveSheet.Shapes("Oval 2").Visible=False 'ワークシート１に楕円の図形２非表示 End Sub Private Sub OptionButton2 Click() ActiveSheet.Shapes("Oval 1").Visible=False 'ワークシート１に楕円の図形１非表示 ActiveSheet.Shapes("Oval 2").Visible=True 'ワークシート１に楕円の図形２表示 End Sub 上記の記述では上手くいくのですが、下記の様に ワークシート２の図形３と４も同様に表示・非表示したいため追加するとエラーになります。 UserForm1に Private Sub OptionButton1 Click() ActiveSheet.Shapes("Oval 1").Visible=True 'ワークシート１の楕円図形１表示 ActiveSheet.Shapes("Oval 2").Visible=False 'ワークシート１の楕円図形２非表示 ActiveSheet.Shapes("Oval 3").Visible=True 'ワークシート２の楕円図形３表示 ActiveSheet.Shapes("Oval 4").Visible=False 'ワークシート２の楕円図形４非表示 End Sub Private Sub OptionButton2 Click() ActiveSheet.Shapes("Oval 1").Visible=False 'ワークシート１の楕円図形１非表示 ActiveSheet.Shapes("Oval 2").Visible=True 'ワークシート１の楕円図形２表示 ActiveSheet.Shapes("Oval 3").Visible=False 'ワークシート２の楕円図形３非表示 ActiveSheet.Shapes("Oval 4").Visible=True 'ワークシート２の楕円図形４表示 End Sub ＶＢＡの勉強中の初心者です。教えて頂けないでしょうか。
- ベストアンサー
- オフィス系ソフト
- エクセルマクロでシート内にある画像のみを選択する
エクセルマクロでシート内にある画像のみを選択する ActiveSheet.DrawingObjects.Select これだとエクセルのシート内にあるすべてのオブジェクトを選択してしまいます。 テキストボックスなどのオブジェクトは選択せずに、写真などの画像のみを 選択したいのですがどのようにしたらよいのでしょうか。 どうかよろしくお願いいたします。
- ベストアンサー
- オフィス系ソフト
- VBAでオートシェイプのグループ化についての質問です。
VBAでオートシェイプのグループ化についての質問です。 オートシェイプ線（Line）で台形を作成し全てを選択し、グループ化したいと考えています。 また、連続して台形を作成していきたいと考えています。 ?4本線を引く ?グループ化（Aグループ） ?4本線を引く ?グループ化（Aグループ） ⇒ 連続して作成・・・ Dim st() As Variant Dim ob As Shape Dim MyLine As Shape '線の作成 Set MyLine = ActiveSheet.Shapes.AddLine(startX, startY, widthX, heightY) '線の選択 For Each ob In ActiveSheet.Shapes ReDim Preserve st(j) st(j) = ob.name j = j + 1 Next ob 'グループ化 Worksheets("test").Shapes.Range(st).Select Selection.ShapeRange.Group.Select と上記コードで一つのグループは作成出来たのですが、次に作成すると Worksheets("test").Shapes.Range(st).Select Selection.ShapeRange.Group.Select でエラーになります。 恐らく前のグループ化内の線も選択してしまうのではないかと思っていますが、対処の仕方が解りません。 線の作成方法から選択方法等いろいろ意見が聞きたいと思っています。 アドバイスよろしくお願いいたします。 m(__)m
- ベストアンサー
- その他（プログラミング・開発）
- ＶＢＡ オートシェイブや図を選択したいのですが
ＶＢＡでシート上にある全てのオートシェイブや図を選択したいのですが どのようにすればいいでしょうか？ 手作業でなら、CTRL+Gでオブジェクトを選択すればできますがVBAで行いたいです。 Sub test() Dim s As Shape For Each s In ActiveSheet.Shapes s.Select Next End Sub をしても、一つずつしか選択できません。 全てを選択状態にしたいです。
- ベストアンサー
- オフィス系ソフト
- エクセルマクロでオブジェクトを選択する方法
エクセル（2002）を使っています。マクロの記録機能を使って円を描くマクロを作成しました。 Sub Maru(xpos, ypos, hankei) ActiveSheet.Shapes.AddShape(msoShapeOval, xpos, ypos, hankei, hankei).Select Selection.ShapeRange.Fill.Visible = msoFalse Selection.ShapeRange.Fill.Solid Selection.ShapeRange.Fill.Transparency = 0# Selection.ShapeRange.Line.Weight = 0.75 Selection.ShapeRange.Line.DashStyle = msoLineSolid Selection.ShapeRange.Line.Style = msoLineSingle Selection.ShapeRange.Line.Transparency = 0# Selection.ShapeRange.Line.Visible = msoTrue Selection.ShapeRange.Line.ForeColor.SchemeColor = 64 Selection.ShapeRange.Line.BackColor.RGB = RGB(255, 255, 255) End Sub 次にこの円を削除したいと思い、同じようにマクロの記録機能を使ったところ、 Sub Macro3() ActiveSheet.Shapes("Oval 64").Select Selection.Delete End Sub となりました。"Oval 64"はオブジェクトの名前のようですが、名前がわかっていないオブジェクト（但し上記マクロで書いたので場所はわかっている）を選択するにはどうしたらいいでしょうか。
- ベストアンサー
- Visual Basic
- エクセル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に入力されるデータが１，２，３，４の4種類、AQ11に５，６，７，８，９の5種類などと、ばらばらです。 P11に１が入力されるとN14:N15(結合されています)に円が入り、２が入力されるとN16に円が入る。 Q11に５が入力されるとR13に円が入り、６が入力されるとR14:R15に円が入る・・・・のようにしたいのです。 一生懸命、セルNo.を打ち込んでいたら、 「コンパイルエラー：プロシージャが大きすぎます」とエラーが出てしまいました。 ループさせればよいのだろうと試してみたのですが、元のセルの指定方法や、オートシェイプの出現させるせるの指定方法がわかりません。 どのようにすれば、データー元の範囲を指定して、それに対応したセルにオートシェイプを出現させる事が出来るようになるでしょうか。 お知恵を貸していただけないでしょうか。よろしくお願い致します。
- ベストアンサー
- その他MS Office製品
お礼
さっそくありがとうございます。 ActiveSheet.Shapes.SelectAllでは、オートシェープ（四角形や三角形、だ円、ブロック矢印、吹き出し、フローチャートなど）以外にも、画像やフォームで挿入したDropDownsやCheckBoxesやButtonsなど、貼り付けたものがみな選択されてしまうので使えないのです。 msoShapeの図形の定数の調べ方、ありがとうございました。