Excel VBAでオートシェイプを表示させる方法について

前へ 次へ
このQ&Aのポイント
  • Excelでチェック表を作成し、入力内容を反映するとオートシェイプが表示されるようにしたい。現在、◎は表示されるが、○が表示されない問題が発生している。VBAのコードを修正する必要がある。
  • VBAコードの「○で囲むVBA」部分を修正すると、一部のセルに入力された1と2以外の値に対しても○が表示されるようになる。
  • 全コードを入力しても、○が表示されない問題が発生する。原因を調査し対応策を見つける必要がある。
回答を見る
  • ベストアンサー

複数のセルのなかに該当があればオートシェイプを表示

http://okwave.jp/qa/q8365189.html 上記質問の続きです。 画像のようなチェック表をExcelで作っています。 右側欄外に表を作成し、 ◎を付ける番号、○をつける番号をそれぞれ入力し、 「入力内容を反映」ボタンをクリックすると、 オートシェイプで配置した◎や○が表示されるようにしたいです。 VBAを以下のように作成してみたのですが、 ◎はつくのですが、 ○をつけるVBAが動きません。 どのように修正するべきでしょうか？ ご教授ください！ Private Sub CommandButton1_Click() '○で囲むVBA Dim c For Each c In Range("U103:Y103") If InStr(c.Value, "1") > 0 Then ActiveSheet.Shapes("1を囲む○").Visible = True Else ActiveSheet.Shapes("1を囲む○").Visible = False End If If InStr(c.Value, "2") > 0 Then ActiveSheet.Shapes("2を囲む○").Visible = True Else ActiveSheet.Shapes("2を囲む○").Visible = False End If Next c ・ ・ ・ '最も重要なものを◎で囲むVBA If Range("T103").Value = "1" Then ActiveSheet.Shapes("1を囲む◎").Visible = True Else ActiveSheet.Shapes("1を囲む◎").Visible = False End If If Range("T103").Value = "2" Then ActiveSheet.Shapes("2を囲む◎").Visible = True Else ActiveSheet.Shapes("2を囲む◎").Visible = False End If ・ ・ ・ End Sub ちなみに「'○で囲むVBA」のコードだけを残して動作させてみると、 1や2が一番右のセル（Y103）に入力されると、1を囲む○、2を囲む○がそれぞれ表示されるのですが、 それ以外のセル（U103からX103）に1や2を入力しても○は表示されません。 全コードを入力して動作させると、 1や2を一番右のセル（Y103）に入力しても○はどこにも表示されません。 よろしくお願いいたします！

画像を拡大する

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

  • ベストアンサー
  • sora1515
  • ベストアンサー率58% (54/92)
回答No.1

ステップ実行のやり方を覚える事をお勧めします。 　（やり方は動かしたいマクロにカーソル(｜)を持っていきF8です。矢印も移動できますよ。）　（ステップ実行中に変数(例えばループc)の値が見たければcを右クリックしウォッチ式の追加で値が見れます） 原因はForループ中(U103～X103)に○を付けても、最後にループした際(Y103時)に○を消しているからです。 ループせず範囲で検索してはいかがでしょう。 If WorksheetFunction.CountIf(Range("U103:Y103"), "1") Then ActiveSheet.Shapes("1を囲む○").Visible = True Else ActiveSheet.Shapes("1を囲む○").Visible = False End If If WorksheetFunction.CountIf(Range("U103:Y103"), "2") Then ActiveSheet.Shapes("2を囲む○").Visible = True Else ActiveSheet.Shapes("2を囲む○").Visible = False End If

masunona
質問者

お礼

ご回答ありがとうございます！ いただいたコードでためしてみたところ理想の動きが出来ました！ ステップ実行をはじめて知ったので早速やってみました。 今後も役立てていきます！ ありがとうございました！

  1. カテゴリ
  2. パソコン・スマートフォン
  3. ソフトウェア
  4. オフィス系ソフト

関連するQ&A

  • 複数のセルのなかに該当があればオートシェイプを表示

    Excelで以下の図のような入力フォームを作成しています。 セルA1に1と入力したら1を◎で囲み、 セルB1からD1に2 4 5と入力したら2 4 5を○で囲みたいです。 それぞれの番号を囲むように、ふたつのオートシェイプを作成し、 それぞれに名前をつけました。 ◎をつける方法は以下のようにVBAを作成しうまくいったのですが、 ○をつける方法がわかりません。 ひとつでなく複数のセルを参照して、そのなかに該当があれば○をつける、 というやり方を教えていただけないでしょうか。 Private Sub Worksheet_Change(ByVal Target As Range) If Target.Address <> "$A$1" Then Exit Sub If Target.Value = "1" Then On Error GoTo SHAPEMAKE ActiveSheet.Shapes("1を囲む内側の○").Visible = True ActiveSheet.Shapes("1を囲む外側の○").Visible = True Else ActiveSheet.Shapes("1を囲む内側の○").Visible = False ActiveSheet.Shapes("1を囲む外側の○").Visible = False End If Exit Sub SHAPEMAKE: ・・・・・・ End With End Sub

  • エクセルVBAでShapesまたはDrawingObjects

    シート上のフォームなどを表示/非表示するためtest04を書きましたが、「実行時エラー438　オブジェクトはこのプロパティまたはメッソッドをサポートしていません」となります。 しかし、Test05のように同じことをForNextで回せばうまくいきます。 また、Test06のようにShapesをDrawingObjectsに書き換えただけでもうまくいきます。 では、Test04がエラーになるのはなぜでしょうか？ Sub test04() With ActiveSheet.Shapes If .Visible = False Then .Visible = True Else .Visible = False End If End With End Sub Sub test05() For Each sp In ActiveSheet.Shapes If sp.Visible = False Then sp.Visible = True Else sp.Visible = False End If Next End Sub Sub test06() With ActiveSheet.DrawingObjects If .Visible = False Then .Visible = True Else .Visible = False End If End With 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に入力されるデータが１，２，３，４の4種類、AQ11に５，６，７，８，９の5種類などと、ばらばらです。 P11に１が入力されるとN14:N15(結合されています)に円が入り、２が入力されるとN16に円が入る。 Q11に５が入力されるとR13に円が入り、６が入力されるとR14:R15に円が入る・・・・のようにしたいのです。 一生懸命、セルNo.を打ち込んでいたら、 「コンパイルエラー：プロシージャが大きすぎます」とエラーが出てしまいました。 ループさせればよいのだろうと試してみたのですが、元のセルの指定方法や、オートシェイプの出現させるせるの指定方法がわかりません。 どのようにすれば、データー元の範囲を指定して、それに対応したセルにオートシェイプを出現させる事が出来るようになるでしょうか。 お知恵を貸していただけないでしょうか。よろしくお願い致します。

  • マクロ　ボタンの非表示

    セルのＧ２に”FALSE”と入力されていた場合、ボタンを非表示にしたいと思っています。 下記のように記述したのですが、ボタンが非表示になってくれません。 間違っていますでしょうか。 If Range("G2").Value = "FALSE" Then ActiveSheet.CommandButton1.Visible = True End If

  • 印刷後のVBAの実行　(3)

    Private Sub Workbook_BeforePrint(Cancel As Boolean) If ActiveSheet.Name = "Sheet1" Then If Range("D6").Value = "" Then Cancel = True MsgBox ("名前を入力してください") Range("D6").Select Exit Sub End If Else If ActiveSheet.Name = "Sheet2" Then If Range("C11").Value = "" Then Cancel = True MsgBox ("受付時間を入力してください") Range("C11").Select Exit Sub End If Else Exit Sub End If End If If Worksheets("Sheet1").Range("D5") = "不要" Then GoTo P1 ActiveSheet.Range("A70:Y70").Copy If Worksheets("Sheet3").Range("A1").Value = "" Then Worksheets("Sheet3").Range("A1").PasteSpecial Paste:=xlPasteValues Else Worksheets("Sheet3").Range("A65536").End(xlUp).Offset(1, 0).PasteSpecial _ Paste:=xlPasteValues End If Application.CutCopyMode = False P1: ActiveSheet.Range("A1").Select End Sub sheet1のD5に「不要」と入っていたら 24～33行目の作業がキャンセルになりますが sheet2のD5にも「不要」と入っていたら、同じ様にキャンセルできる様に出来ますでしょうか？ ご回答お願いします

  • 印刷後のVBAの実行　(2)

    Private Sub Workbook_BeforePrint(Cancel As Boolean) 　　If ActiveSheet.Name = "Sheet1" Then 　　　　If Range("D6").Value = "" Then 　　　　　　Cancel = True 　　　　　　MsgBox ("名前を入力してください") 　　　　　　Range("D6").Select 　　　　　　Exit Sub 　　　　End If 　　Else 　　　　If ActiveSheet.Name = "Sheet2" Then 　　　　　　If Range("C11").Value = "" Then 　　　　　　　　Cancel = True 　　　　　　　　MsgBox ("受付時間を入力してください") 　　　　　　　　Range("C11").Select 　　　　　　　　Exit Sub 　　　　　　End If 　　　　Else 　　　　　　 　　　　　　Exit Sub 　　　　End If 　　End If 　　ActiveSheet.Range("A70:Y70").Copy 　　If Worksheets("Sheet3").Range("A1").Value = "" Then 　　　　Worksheets("Sheet3").Range("A1").PasteSpecial Paste:=xlPasteValues 　　Else 　　　　Worksheets("Sheet3").Range("A65536").End(xlUp).Offset(1, 0).PasteSpecial _ 　　　　　　Paste:=xlPasteValues 　　End If 　　Application.CutCopyMode = False 　　ActiveSheet.Range("A1").Select End Sub 先日、上記のコードを回答者の方から教えてもらい、とても助かっていますが sheet1のD5に「不要」という文字が入っていた場合、 sheet3への貼り付け(23～30行目の作業)をキャンセルして、最後にsheet1のA1を選択するようにはどの様にしたらいいでしょうか?

  • このEXCELVBAを複数のセルにも別々に同じ処理をしたい

    はじめまして。 過去ログに私のやりたいような内容を探していたらこのような下記のエクセルVBAがあったので、 教えて頂きたいです。 Private Sub Worksheet_Change(ByVal Target As Range) If Target.Address <> "$A$1" Then Exit Sub If Target.Value = "" Then Exit Sub x = Target.Value With Application .ScreenUpdating = False .EnableEvents = False .Undo y = Target.Value Target.Value = x + y .EnableEvents = True .ScreenUpdating = True End With With Cells(ActiveSheet.Rows.Count, "C").End(xlUp) .Offset(1, 0).Value = x .Offset(1, 1).Value = Time() End With End Sub A1に入力するたびに同一セルに加算。 A1をクリアできる。 C列に入力履歴、D列に入力時間を記録。 If Target.Address <> "$A$1" Then Exit Sub　の$A$1を変えることによって他のセルにも設定できる。 と、いう内容なのですが、これを同一シートの複数のセルにも同じよう別々に処理できるように設定したいのですが、 どのようにすればいいのでしょうか？ VBAは最近始めたばかりなのでわからない事だらけです。 Excelのバージョンは2003です。 よろしくお願い致します。

  • Shapes の使い方について

    今まで、Excel VBA で、 If ActiveSheet.Button1.Visible = False Then 　　Exit Sub End If が問題なく動いていましたが、VISTA を使っておられる人からエラーが出るという指摘を受けました（Excel のバージョンはわかりません）。どうやら上の文に問題があるような気がして、いろいろ調べてみましたら、皆さん If ActiveSheet.Shapes("Button1").Visible = False Then 　　Exit Sub End If としておられるようなのです。なぜ、Shapes("Button1")としなければならないのか、教えていただけませんか。

  • オートフィルタで非表示セルの判定

    オートフィルタでフィルタ後、表示されない行にあるボタンを消したいのですが表示されていないセルの判定方法がわかりません。 下のマクロではエラーが出ます。 よろしくお願いします。 If ActiveSheet.Range("a10").Visible = False Then ボタンを消すマクロ End If

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

    エクセルマクロでセルにオートシェイプを張る方法を調べていて、ここで丁度いいのを見つけました。 http://oshiete1.goo.ne.jp/kotaeru.php3?q=808898 見つけた下記のマクロを実際にやってみました。 A1に１を入れるとB2にハートマークが出ます。 しかし、さらに２を入力してもB2のハートは削除されてくれません。 さらに１をいれると、ハートの上にハートが重なってしまいます。 １ならハート、それ以外の入力ならハートが消えるようにするにはどうすればいいのでしょうか？ 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

注目のQ&A

カテゴリ

専門家に質問してみよう

職業から探して質問する

あなたにピッタリな商品が見つかる！ OKWAVEセレクト

質問する