Excel VBAで、特定の名前のオートシェイプの有無を確認する方法
- Excel VBAにおいて、特定の名前のオートシェイプが存在するかどうかを確認する方法を知りたいです。オートシェイプを削除したり再作成する際に、エラーを回避するために、名前の存在を事前にチェックしたいです。
- Excel VBAで特定のオートシェイプが存在するかどうかを確認する方法を教えてください。オートシェイプを削除したり、同じ名前で作成する際に、エラーハンドリングを行う前に事前にオートシェイプの存在を確認したいです。
- Excel VBAで、特定の名前のオートシェイプが存在するかどうかを確認する方法を教えてください。オートシェイプが存在しない場合にエラーを回避するために、事前に名前の存在をチェックしたいです。
- ベストアンサー
特定の名前のオートシェイプの有無を知りたい（エクセルVBA）
Excel VBA で、オートシェイプを扱おうとしています。 たとえば、 ActiveSheet.Shapes.AddShape(msoShapeRectangle, 10, 10, 50, 50).Name = "TestShape1" のようにして、それぞれ名前を付けているのですが、プログラム中、特定のオートシェイプを削除したり、再び同じ名前で作ったり、ということを行っています。 前者の場合、すでに当該オートシェイプが削除されている場合、目的のオートシェイプが存在していないためか、エラーが発生します。また後者の場合も、オートシェイプを重ねて作成することになってしまうケースにエラーが発生します。 On Error Resume Next で回避することも考えられるでしょうが、もっと直接的に、ある名前のオートシェイプが存在する／しない、をチェックしたうえで各処理を行うようにしたいのです。 どのような方法があるでしょうか？
- greetinggreentea
- お礼率71% (25/35)
- オフィス系ソフト
- 回答数2
- ありがとう数8
- みんなの回答 （2）
- 専門家の回答
質問者が選んだベストアンサー
Dim objShp As Shape For Each objShp In ActiveSheet.Shapes If objShp.Name = "TestShape1" Then 処理Y '該当オートシェイプありの場合の処理 Else 処理N '該当オートシェイプなしの場合の処理 End If Next
その他の回答 (1)
- wuyan
- ベストアンサー率51% (183/352)
先の回答は間違いでした。 (Dim 行はそのまま) 該当オートシェイプありで処理したい場合 For Each objShp In ActiveSheet.Shapes If objShp.Name = "TestShape1" Then 処理 '該当オートシェイプありの場合の処理 End If Next ---- 該当オートシェイプなしで処理したい場合はたとえば(必要に応じて工夫してください) For Each objShp In ActiveSheet.Shapes If objShp.Name = "TestShape1" Then MsgBox "該当オートシェイプあり" Exit Sub 'あればマクロを終了 End If Next 処理 '該当オートシェイプなしの場合の処理 ----
お礼
重ねてありがとうございます。助かりました。
関連するQ&A
- ShapeのVBAの中での取り扱い
ShapeのVBAの中での取り扱いに関して、サジェスチョン願います。 Shapeに文字が書き込まれていない段階で、選択して文字を読み込み判定しようとするとエラーとなります。 下記のVBAでは、5番目のShapeが該当します。 このエラーを防ぐためには、On Error Resume Nextが有効ですが、他の方法を探しています。例えば、charactor=trueみたいなもの。 ----- Sub Shapeの調査() Dim nametemp(10) As String Dim temp As Integer Dim i As Integer Dim aaa As Variant 'On Error Resume Next ActiveSheet.Shapes.AddShape(msoShapeRectangle, 50, 50, 50, 50).Select ActiveSheet.Shapes.AddShape(msoShapeOval, 100, 100, 50, 50).Select ActiveSheet.Shapes.AddTextbox(msoTextOrientationHorizontal, 150, 150, 50, 50).Select ActiveSheet.Shapes.AddShape(msoShapeRectangle, 200, 200, 50, 50).Select ActiveSheet.Shapes.AddShape(msoShapeOval, 250, 250, 50, 50).Select temp = ActiveSheet.Shapes.Count For i = 1 To temp ActiveSheet.Shapes(i).Select nametemp(i) = ActiveSheet.Shapes(i).Name Next For i = 1 To temp / 2 + 1 '4つのshapeに対し、文字を書き込もうとする ActiveSheet.Shapes(nametemp(i)).Select Selection.Characters.Text = "" Next For i = 1 To temp / 2 '3つに対して、文字を書き込む ActiveSheet.Shapes(nametemp(i)).Select Selection.Characters.Text = "zzzzz" Next For i = 1 To temp ActiveSheet.Shapes(nametemp(i)).Select aaa = Selection.Characters.Text '<--5番目のShapeに対し If aaa = "zzzzz" Then MsgBox (aaa)'<--errorとなる。 Next End Sub
- ベストアンサー
- オフィス系ソフト
- VB6 オートシェイプ描画
VB6 オートシェイプ描画 VB6でExcel,2000(ActiveSheet)にオートシェイプを使用したいのですが、エラーが出てしまいます。 コマンドボタンクリック時、エラー ------------------------------- 実行時エラー'1004': 指定された値は境界を超えています。 ------------------------------- AddLineは出来たのですが四角や円がこのエラーです。どこが間違えているのでしょうか？ 宜しくお願いします。 Private Sub CB13_Click() Dim xlApp As Excel.Application Set xlApp = GetObject(, "Excel.Application") xlApp.ActiveSheet.Shapes.AddLine 50, 50, 100, 100 '(OK) xlApp.ActiveSheet.Shapes.AddShape(msoShapeRectangle, 50, 50, 100, 100).Select '(NG) Set xlApp = Nothing End Sub
- ベストアンサー
- Visual Basic
- エクセルVBAの構文。 どこが間違っているのでしょうか？
以下の２つは同じ意味だと思うのですが、test2はエラーになります。どうしてなのでしょうか？ Sub test1() ActiveSheet.Shapes.AddShape(msoShapeRectangle, 300#, 100#, 140#, 80#).Select Selection.Formula = "$A$1" End Sub Sub test2() With ActiveSheet.Shapes.AddShape(msoShapeRectangle, 300#, 100#, 140#, 80#) .Formula = "$A$1" End With End Sub
- ベストアンサー
- オフィス系ソフト
- エクセルVBAで、ある特定の名前のオブジェクトが存在するかどうかの確認方法
Sheets("XXX").Shapes("SN").Deleteとすると、SNという名前のShapeが存在しなと当然エラーになります。 そこで、「SNがあったら削除する」と書きたいのですが、いい方法が思い当たりません。 For Each ～ Nextでshapeの名前を一個ずつしらべ、あったら削除する方法や、存在しない場合 On Error Resume Nextでエラーを強制的に回避するのではなく、Shapes("SN")があればDeleteするというようにすっきり書く方法は無いでしょうか？
- 締切済み
- オフィス系ソフト
- 選択したセルにピッタリ合うオートシェイプの挿入
よろしくお願いいたします。 下記のコードは行方向では選択したセルとピッタリに四角のオートシェイプが挿入できるのですが、列方向では常に１行です。 横方向も選んだ範囲だけ広がるようにするにはどう変えたらよいでしょうか。 Set shrect = ActiveSheet.Shapes.AddShape(msoShapeRectangle, _ Selection.Left, Selection.Top, Selection.Offset(0, 1).Left - Selection.Left, _ Selection.Height)
- ベストアンサー
- Visual Basic
- オートシェイプの名前の取得
エクセル２０００を使用してます オートシェイプをクリックしたときはわかるのですが・・・ Sub オートシェイプ14_Click() Dim objShape As Shape Dim ShapeName As String Set objShape = ActiveSheet.Shapes(Application.Caller) ShapeName = objShape.Name End Sub 新規でオートシェイプ作成されたとき、その名前を取得するにはどうしたらいいのでしょう。 作成された順番にセルに表示したいのです
- ベストアンサー
- オフィス系ソフト
- JavaScriptで書き出したオートシェイプにテキストを挿入したいの
JavaScriptで書き出したオートシェイプにテキストを挿入したいのですができません。 先日、ExcelのシートにJavaScriptでオートシェイプを書き出す方法を質問した者です。 今度は書き出したオートシェイプにテキストを挿入したいのですが上手くいきません。 どうすれば良いのか教えてください。 ※またもやJavaScriptで解決したいです。 なお、現在悩み中のソースは以下のようです。 ※教えて頂いたソースほとんどそのままですが... function createShapes() { var excel = new ActiveXObject( "Excel.Application" ); excel.visible = true; var sheet = excel.Workbooks.Add().activeSheet; // オートシェイプ挿入：引数の１０５は吹き出しを示す sheet.Shapes.AddShape(105, 123, 37.5, 151.5, 94.5); // ココでメソッド、プロパティがないとエラーになってしまう... sheet.Shapes("AutoShape 1").Characters.Text = "ほげほげ"; } よろしくお願いします。
- ベストアンサー
- JavaScript
- 挿入したオートシェイプが文字入力待機状態にする方法
昨日HohoPapaさんに選択したセルとピッタリ合うオートシェイプの挿入の仕方を教えていただきました。 今度は、オートシェイプがアクティブ状態とでもいうのでしょうか、挿入後すぐにタイプしたら文字が入力できる状態にする方法を教えていただきたいです。フォントのサイズ、位置は不問で黒色で入力できればと思います。 よろしくお願いいたします。 Set shrect = ActiveSheet.Shapes.AddShape(msoShapeRectangle, _ Selection.Left, Selection.Top, Selection.Width, _ Selection.Height) shrect.Fill.ForeColor.SchemeColor = 22 'Grey 'shrect.Font.Color = vbBlack ←うまくいかなかった部分
- ベストアンサー
- 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製品
- Excelでグループ化したオートシェイプにテキストを編集するコード
Excelの四角のオートシェイプで、例えば、「四角1」「四角2」「四角3」という名前のオートシェイプが3つあったとしてテキスト編集で同じ文字列を入れたいとき、 For a = 1 To 3 ActiveSheet.Shapes("四角" & a).Select Selection.Characters.Text = "文字列" Next a とすればできるのですが、「四角1～3」をグループ化し、名前を「四角」としたとき、 ActiveSheet.Shapes("四角").Select Selection.Characters.Text = "文字列" とするとエラーが出てしまいます。グループ化されたオートシェイプのテキスト編集は、一度グループを解除し、それぞれテキスト編集しなければならないのでしょうか？ 回答よろしくお願いします。
- ベストアンサー
- その他MS Office製品
お礼
結局、いちいち名前を確認してやるしかないのですかね。 オートシェイプの数も少ないので、これでやることにします。 ありがとうございました。