• ベストアンサー

フォームボタンを残して画像を消したい

マクロ初心者です。こちらではいつもお世話になっております。 現在、以下のような構文で、ある特定のセル（ここではB1セル）にかかっている画像を消すというマクロを組んでいます。 Sub 画像を消す() Dim shp As Shape For Each shp In ActiveSheet.Shapes If shp.TopLeftCell.Address = "$B$1" Then shp.Delete End Sub これで画像は消えるのですが、同時にこのマクロを実行するために設定してあるフォームボタンまで一緒に消えてしまうので困っています。 B1セルにボタンの一部がはみ出しているためですが、このボタンをB1セルにかからないように縮小すると使いづらいので、 何とか今のはみ出したままでも使えるようにしたいです。 フォームボタンのみを残して画像を消すには、どのような構文に変えればよいのでしょうか？ お知恵をお貸しいただければ幸いです。よろしくお願いします。

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

  • ベストアンサー
  • KenKen_SP
  • ベストアンサー率62% (785/1258)
回答No.1

こんな感じとか。 Sub 画像を消す() 　　 　　Dim shp　　As Object 　　For Each shp In ActiveSheet.DrawingObjects 　　　　If shp.TopLeftCell.Address = "$B$1" Then 　　　　　　If UCase$(TypeName(shp)) = "PICTURE" Then 　　　　　　　　shp.Delete 　　　　　　End If 　　　　End If 　　Next End Sub

lightheart
質問者

お礼

解決できました。 ありがとうございました！

全文を見る
すると、全ての回答が全文表示されます。
  1. カテゴリ
  2. パソコン・スマートフォン
  3. ソフトウェア
  4. オフィス系ソフト

関連するQ&A

  • コマンドボタンを削除しないか自動生成する

    エクセルのマクロで、不要な表やオブジェクトを一括で削除するためのマクロを作成し、コマンドボタンをシートに作成してマクロを登録しています。 コマンドを実行すると、不要な表やオブジェクトと一緒に、マクロを実行するためのコマンドボタンも削除されてしまいます。 そのため、コマンドボタンを削除されないためにはどうしたらいいでしょうか。 あるいは、コマンドボタンを自動で生成し、マクロを登録するにはどうしたらいいでしょうか。 参考までに、オブジェクトを削除するマクロは次の通りです。 Sub 削除() Cells.Delete Dim shp As Shape For Each shp In ActiveSheet.Shapes shp.Delete Next shp 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.を打ち込んでいたら、 「コンパイルエラー：プロシージャが大きすぎます」とエラーが出てしまいました。 ループさせればよいのだろうと試してみたのですが、元のセルの指定方法や、オートシェイプの出現させるせるの指定方法がわかりません。 どのようにすれば、データー元の範囲を指定して、それに対応したセルにオートシェイプを出現させる事が出来るようになるでしょうか。 お知恵を貸していただけないでしょうか。よろしくお願い致します。

  • マクロを使って結合セルに丸を付ける＋αな難題。。

    エクセルのマクロについて エクセルでセルや結合セルに丸を付ける質問はどれも見ましたが私にとって難題なものがありましたので、教えて下さい。　 結合セルをマクロを使用して丸を付けるものがありますが、どなたか教えては頂けないでしょうか。初心者です、すいません。 １、ダブルクリックで結合セルに文字上に丸（太さ0.75）がつく。 ２、ダブルクリックでそのセルから丸が消える。 同じ操作で1,2が繰り返される。 さらにここでもう一つ。 同シート内の※別の場所の結合セルに【データ】の【入力規制】で（リスト）を選択し、リスト内に【■,○,空白,】等の内容を含んでいます。 この上の二つがどちらもちゃんと使える方法が分かりません。 教えては頂けないでしょうか。 ちなみに参考までにマクロはこれを使っています。 正しいマクロを教えて下さい。 Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) Dim Shp As Shape Cancel = True If ActiveSheet.Shapes.Count <> 0 Then For Each Shp In ActiveSheet.Shapes If Target.Address = Shp.TopLeftCell.Address Then Select Case Shp.Line.DashStyle Case 1: Shp.Delete: Exit Sub Case 4: Shp.Delete: Exit Sub End Select End If Next End If With ActiveSheet.Shapes.AddShape(msoShapeOval, Target.Left, Target.Top, Target.Width, Target.Height) .Fill.Visible = msoFalse .Line.Weight = 0.75 End With End Sub これと入力規制を使おうとしたら、マクロがデバックになってしまい使用できません。 入力規制は残ったままですが、マクロが使えなくなってしまいました。 解決策、何か違うところ、教えて下さい。

  • オプションボタンで○を描いたり消したり

    いつもありがとうございます。 今度は下記内容で悩んでいます。 どなたか、助けて下さい。 （したい事） オプションボタン1を押す セルＪ58に○をいっぱいにオートシェイプで描く 同時にセルJ62のオートシェイプがあれば消す オプションボタン2を押す セルＪ62に○をいっぱいにオートシェイプで描く 同時にセルJ58のオートシェイプがあれば消す これと同じ作業ができるシートを10枚作りたいのですが・・・ 各シートはリンクせず、シート内にそれぞれ２つのオプションボタンで対応したいのです。 とりあえず、下記コードを作ったのですが、他のPCですとセルからづれてしまうので セル内に収まるような最大の○を付したいので、どなたかご教授お願い致します。 Sub (1)オプション1_Click() ActiveSheet.Unprotect ActiveSheet.Shapes.AddShape(msoShapeOval, 185, 628, 45.5, 14.5).Select Selection.ShapeRange.Line.Weight = 1 Selection.ShapeRange.Fill.Visible = msoFalse With ActiveSheet For Each ob In .DrawingObjects If Not Intersect(ob.TopLeftCell, .Range("J62")) Is Nothing Then ob.Delete End If Next End With Range("J58").Select ActiveSheet.Protect End Sub

  • 回転させた画像を左上のセルにフィットさせたい

    以下のマクロは画像を画像の左角のセルの左隅にフィットさせる マクロのようです。回転させていな画像は問題なく左隅にフィットする のですが回転させた図形の場合はフィットしません。回転させた図形 でも問題なくフィットさせることができるマクロはないでしょうか？ ご教示よろしくお願いいたします。 Sub 左角のセルにフィット() Dim pict On Error Resume Next For Each pict In ActiveSheet.Shapes pict.Left = pict.TopLeftCell.Left pict.Top = pict.TopLeftCell.Top Next pict End Sub

  • 指定範囲内のオートシェイプを数えるには？

    I5:I24の範囲内のオートシェイプの数を数え、I25に合計数を表示させるマクロを作っているのですが、どうしても範囲指定の仕方が分かりません。教えてください。 'オートシェイプの合計数算出 Dim shp As Object Dim cnt As Long For Each shp In ActiveSheet.Shapes If shp.Type = msoAutoShape Then If shp.TopLeftCell.Column = 9 Then cnt = cnt + 1 End If End If Next shp Range("I25").Value = cnt このマクロのどこにどう入れればよいでしょうか？

  • 既存のエクセルマクロに命令文を追加

    既存のマクロに別の命令文を追加する場合について質問です。 選択した範囲のオブジェクトを削除するマクロがあります。 下の命令文に 「シート2でも同じことをする（ただし選択範囲はC30からG33）」 を追加する場合には、どのように書けばいいのでしょうか？ Sheets("シート1").Select Range("A65:E365").Select Dim shp As Shape Dim rng_shp As Range 'セルが選択されていないときは終了 If TypeName(Selection) <> "Range" Then Exit Sub 'アクティブシートのすべての図形にループ処理 For Each shp In ActiveSheet.Shapes '図形の配置されているセル範囲をオブジェクト変数にセット Set rng_shp = Range(shp.TopLeftCell, shp.BottomRightCell) '図形の配置されているセル範囲と '選択されているセル範囲が重なっていれば図形を削除 If Not Intersect(rng_shp, Selection) Is Nothing Then shp.Delete End If Next Sheets("シート0").Select Range("A1").Select 同じものを上記命令文の下にコピーして選択シートと範囲を直すだけだと、 Dim shp As ShapeとDim rng_shp As Rangeがエラーになります。 どなたかご教示お願いします。

  • オートシェープをグルーピングして動作させたい

    office365 ２つのオートシェープをグルーピングして図形を動作させたい 下記で kibanは平行四辺形のオートシェープ yajirushiは右向き矢印のオートシェープ で、それぞれ、ある範囲で左から右に移動を繰り返します。 この２つのオートシェープをグルーピングして 平行四辺形の右側に矢印を配置した状態で、そのグルーピングされた図形の動作を繰り返す様にしたいのですが、 その内容が分からないのでコードで教えていただきたく、よろしくお願いします。 #If Win64 Then Private Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As LongPtr) #Else ' Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long) #End If Sub kiban() shape_delete Dim ws2 As Worksheet Dim i As Integer Set ws2 = Sheets("sheet1") ws2.Shapes.AddShape(msoShapeParallelogram, 2265, 354, 46, 20).Select With Selection.ShapeRange.Fill .Visible = msoTrue .ForeColor.RGB = RGB(0, 176, 80) .Transparency = 0 .Solid End With ws2.Shapes.AddShape(msoShapeParallelogram, 2265, 458, 20, 20).Select ws2.Shapes(ws2.Shapes.Count).name = "kiban" For i = 0 To 30 If i = 30 Then i = 0 End If ws2.Shapes(1).Left = i * 3 + 365 ws2.Shapes(1).Top = 458 Sleep 100 DoEvents Next i ws2.Shapes("kiban").delete End Sub Sub yajirushi() shape_delete Dim ws As Worksheet Dim i As Integer Set ws = Sheets("sheet1") ws.Shapes.AddShape msoShapeRightArrow, 2265, 458, 20, 20 ws.Shapes(ws.Shapes.Count).name = "yajirushi" For i = 0 To 30 If i = 30 Then i = 0 End If ws.Shapes(1).Left = i * 3 + 420 ws.Shapes(1).Top = 458 Sleep 100 DoEvents Next i ws.Shapes("yajirushi").delete End Sub Sub shape_delete() Dim shp As Shape Dim rng As Range Range("P22:CM28").Select If TypeName(Selection) <> "Range" Then Exit Sub For Each shp In ActiveSheet.Shapes '‘ 図形の配置されているセル範囲をオブジェクト変数にセット Set rng = Range(shp.TopLeftCell, shp.BottomRightCell) '‘ 図形の配置されているセル範囲と '‘ 選択されているセル範囲が重なっているときに図形を削除 If Not (Intersect(rng, Selection) Is Nothing) Then shp.delete End If Next End Sub

  • エクセル2000と2007でボタン（フォーム）の認識が違って困っていま

    エクセル2000と2007でボタン（フォーム）の認識が違って困っています。 エクセル2007でシート内に設置したボタン（押したらマクロが実行されるように）をマクロで消したいと思い、「マクロの記録」にて以下のような記述で消すことができたのですが、これをエクセル2000(互換性にて）同じ事を行うとるすと、消そうするボタンが特定できず、、"Button 1"→"Button 10"と 変更すると消す事ができました。 ActiveSheet.Shapes("Button 1").Select Application.CutCopyMode = False Selection.Delete マクロでボタンやフォームを消す場合、はやり2000と2007とでは記述の仕方に違いがあるのでしょうか？できれば、どちらでも消せるようにしたいと思っております。 現状は2007用と2000用を別々にファイル作成しています。よろしくお願い致します。

  • エクセルに画像を取り込めたのですが・・・

    マクロでクリアしたいのですけど クリアボタンでどんな命令を入れたらよいのでしょうか？ Shape1.Delete　で消せと、本には書いてあるのですが・・・ Sub クリア() Range("P4").Select Selection.ClearContents Range("P4").Select Shape1.Delete End Sub だと、エラーになります・・・当たり前ですが・・・ 文字と一緒に消したいのに消えない・・・ それと、写真をファイル名で検索して取り込むのことは可能ですか？ Sub クリック写真表示() Dim shape1 As Object Set shape1 = ActiveSheet.Shapes.AddPicture("C:\Users\Iida\Pictures\10001.bmp", _ False, True, 549, 62, 161, 121) Range("P4").Select End Sub これだと、指定した写真しか入りません。。。 IFが使えるということなんですが・・・？？ すべて跳ね返されます。。。頭が痛い・・・

注目のQ&A

カテゴリ

専門家に質問してみよう

職業から探して質問する

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

質問する