[[20180331192245]]　『アクティブセルの図を選択』（Pic）　ページの最後に飛ぶ

『アクティブセルの図を選択』（Pic）

すごく簡単なはずですが，for文でセルを選択し，そのセルの中にある画像を削除したいだけなのですが，どう書けばいいのでしょうか？

Sub 削除()

    for i =1to100 
       cell( i , i ).Select
       ActiveCell.Shapes.Delete
　　Next i
End Sub

単純にアクティブセルの図をうまく選択できません。
教えてください。

＜使用 Excel：Excel2013、使用 OS：Windows10 ＞

こんばんは　＾＾　選択中のシート内の図、全部消してしまいますけど。^^;;;

Sub btn_del()

    Dim btn As Object
    For Each btn In ActiveSheet.Shapes
        btn.Delete
    Next
 End Sub
では

（隠居じーさん） 2018/03/31(土) 19:45

早速のご返事ありがとうございます。
全部だと困るので，選択したセルだけ，と思っていたのですが，
もう少し複雑に作る必要があるのでしょうか…
（Pic） 2018/03/31(土) 19:46

いろいろ方法は有るかもしれませんが。　＾＾
図形に名前を付けて
名前を参照して消したい画像を消すのも一手かと。

（隠居じーさん） 2018/03/31(土) 19:56

[[20080728110751]]　『選択セル内の図形のみ削除』（ぶんコ）

（マナ） 2018/03/31(土) 19:57

＞選択したセルだけ

ところで、もしマウスでセル範囲を選択するという意味なら、
オブジェクトの選択を使えば、
Deleteキーを押すだけでマクロ不要です。

（マナ） 2018/03/31(土) 20:10

マナさんありがとうございます。
しかし，選択したいセルはいくつかあるので，
マクロで自動化したいのです。
（Pic） 2018/03/31(土) 20:28

調べてみて，次のように作ってみましたが，消えるセルと消えないセルがあります…
具体的には，A列に1行おきに図形がある状態です。

Sub 削除()
for i = 1 to 10
With ActiveSheet

    For Each ob In .DrawingObjects
    If Not Intersect(ob.TopLeftCell, .Range(Cells(2 * i , 1), Cells(2 * i , 2))) Is Nothing Then
    ob.Delete
    End If
    Next ob
End With

End Sub
（Pic） 2018/03/31(土) 23:21

 こんばんは！
ちょっと書いてみました。
どうでしょうか？

 駄目な時があるかもしれません。その時は、ごめんなさい。

 Option Explicit
Sub てすと()
Dim MySp As Shape
Dim Myr As Range
Dim MyTbl As Range
Dim r As Range
Dim y() As Variant
Dim MyMsg As String
Dim k As Long
With Sheets("Sheet1")
    For Each MySp In .Shapes
        Set Myr = .Range(MySp.TopLeftCell.Address, MySp.BottomRightCell.Address)
        If MyTbl Is Nothing Then
            Set MyTbl = Myr
        Else
            Set MyTbl = Union(MyTbl, Myr)
        End If
    Next
    If Not Intersect(Selection, MyTbl) Is Nothing Then
        For Each r In Intersect(Selection, MyTbl)
            k = k + 1
            ReDim Preserve y(k)
            y(k) = r.Address(0, 0)
        Next
        MyMsg = Join(y, vbCrLf)
        If vbYes = MsgBox(MyMsg & vbCrLf & "に、図があります。" & vbCrLf & vbCrLf & _
            "削除しますか？", vbYesNo + vbDefaultButton2) Then
            Set MyTbl = Intersect(Selection, MyTbl)
            For Each MySp In .Shapes
                Set Myr = .Range(MySp.TopLeftCell.Address, MySp.BottomRightCell.Address)
                If Not Intersect(Myr, MyTbl) Is Nothing Then
                   MySp.Delete
                End If
            Next
            Erase y
        End If
    Else
        MsgBox "選択範囲に図はありません。"
    End If
End With
End Sub
v(=∩_∩=)v
（SoulMan） 2018/03/31(土) 23:38

すごい！こんな短時間にこんなマクロを…自分自身，勉強不足です…
題名から大分離れてしまいましたが，やりたいことは，選択したセル上にある図の選択，削除です。
すべて一括で消せるなら楽なのですが，消してはいけない図もあるのです。
一つ一つ，消すかどうかを選ぶのでは無く，マクロでセルを選択し，そのセル上の図を消したいのです。
すいませんが，お力を貸してください。
（Pic） 2018/03/31(土) 23:44

 あっ、すみません
明日は、年度末で珍しく仕事なんです(⌒-⌒; )
マクロでセルを選択ってインプットボックスのことですか？
基本的にselectionが選択範囲なのでそこをアレンジされたら
いいと思います
ちょっとお勉強しておいて下さい。
もう寝ます
おやすみなさい💤
（SoulMan） 2018/04/01(日) 00:23

上で紹介した過去スレは読んでいただけたのでしょうか。

（マナ） 2018/04/01(日) 07:41

マナさん，ありがとうございました。
先ほど確認しました。これでほぼ思い通りの動作をしそうです。
ただ，セル上の図を選択したいだけなのですが，簡単ではないようですね…

（Pic） 2018/04/01(日) 10:02

　＞マクロでセルを選択し，そのセル上の図を消したいのです。

マクロでセルを選択できるなら、
マクロで図形を選択したらいいんじゃないですか？

つまりどうやって削除したい図形を取捨選択するのですか？

（まっつわん） 2018/04/01(日) 14:58

暇つぶしに。。。

こういうことじゃないのかな？

Sub test()

    Dim r As Range

    If TypeName(Selection) = "Range" Then
        For Each shp In ActiveSheet.Shapes
            '選択したセル範囲の上に図形が掛かっていたら消す
            If Not Intersect(Selection, Application.Range(shp.TopLeftCell, shp.BottomRightCell)) Is Nothing Then
                shp.Delete
            End If
        Next
    End If
End Sub
（まっつわん） 2018/04/01(日) 15:07

こうじゃないの？って投稿しようとしたらまっつわんさんとカブッタ・・・
まぁせっかくなので投稿しておきます。

    Sub テスト()
        Dim セル範囲 As Range
        Dim tmp As Shape

        Set セル範囲 = Range("A1:D5")
        For Each tmp In ActiveSheet.Shapes
            If Not Intersect(tmp.TopLeftCell, セル範囲) Is Nothing Then
                tmp.Delete
            End If
        Next tmp
    End Sub
（もこな２） 2018/04/01(日) 15:37

質問と関係ないですが、
＞「アクティブセル」の図を選択

たぶん、これ「選択中のセル範囲」の間違いですよね

間違っていたらごめんなさいだけど、
アクティブセル・・・・・複数あることはない、単一セルしかありえない
選択中のセル範囲・・・・複数の連続しないセル範囲である場合もある。それぞれの連続するセル範囲は単一、複数どちらもありうる
だとおもうので、そこの辺も考えながら質問するとよいかもです。
（もこな２） 2018/04/01(日) 16:07

 想像力をMaxにしてトピ主さんのコードを引用しながら、コードを書いてみました。
ちょっと体調が悪いのか？動悸がするんですよねぇ、、、、
年かな？？？

 Option Explicit
Sub てすと()
Dim MySp As Shape
Dim Myr As Range
Dim Myrr As Range
Dim MyTbl As Range
Dim MyTblA As Range
Dim y() As Variant
Dim MyMsg As String
Dim k As Long
Dim i As Long
    With Sheets("Sheet1")
        For Each MySp In .Shapes
            Set Myr = .Range(MySp.TopLeftCell.Address, MySp.BottomRightCell.Address)
            If MyTbl Is Nothing Then
                Set MyTbl = Myr
            Else
                Set MyTbl = Union(MyTbl, Myr)
            End If
        Next
        For i = 1 To 10
            Set Myrr = .Range(.Cells(2 * i, 1), .Cells(2 * i, 2))
            If MyTblA Is Nothing Then
                Set MyTblA = Myrr
            Else
                Set MyTblA = Union(MyTblA, Myrr)
            End If
        Next
        If Not Intersect(MyTbl, MyTblA) Is Nothing Then
            For Each r In Intersect(MyTbl, MyTblA)
                k = k + 1
                ReDim Preserve y(k)
                y(k) = r.Address(0, 0)
            Next
            MyMsg = Join(y, vbCrLf)
            If vbYes = MsgBox(MyMsg & vbCrLf & "に、図があります。" & vbCrLf & vbCrLf & _
                "削除しますか？", vbYesNo + vbDefaultButton2) Then
                For Each MySp In .Shapes
                    Set Myr = .Range(MySp.TopLeftCell.Address, MySp.BottomRightCell.Address)
                    If Not Intersect(Myr, MyTblA) Is Nothing Then
                       MySp.Delete
                    End If
                Next
                Erase y
            End If
        Else
            MsgBox MyTblA.Address(0, 0) & "に、図はありません。"
        End If
    End With
    Set Myr = Nothing
    Set Myrr = Nothing
    Set MyTbl = Nothing
    Set MyTblA = Nothing
End Sub

 お馬さんが外れたからかな？？？？
 v(=∩_∩=)v
（SoulMan） 2018/04/01(日) 16:37

みなさん，返信ありがとうございます。
アクティブと選択。確かに違いますよね。
一つ一つセルを選んで削除しようと考えていましたが，複数のセルを選んで削除の方が，早い気もします。
いろいろな考え方があり，しかもやりたいことは単純ですが，難しいと分かっただけでも助かりました。
まだまだ勉強して，取り組んでいきたいと思います。

SoulManさんのマクロ素敵です。これを元に考えてみます！
（Pic） 2018/04/01(日) 21:09

コメント返信：

[ 一覧(最新更新順) ]

[[20180331192245]] 『アクティブセルの図を選択』（Pic） ページの最後に飛ぶ

[[20180331192245]]　『アクティブセルの図を選択』（Pic）　ページの最後に飛ぶ