[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『アクティブセルの図を選択』(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
(隠居じーさん) 2018/03/31(土) 19:56
(マナ) 2018/03/31(土) 19:57
ところで、もしマウスでセル範囲を選択するという意味なら、
オブジェクトの選択を使えば、
Deleteキーを押すだけでマクロ不要です。
(マナ) 2018/03/31(土) 20:10
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
Next
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
あっ、すみません 明日は、年度末で珍しく仕事なんです(⌒-⌒; ) マクロでセルを選択ってインプットボックスのことですか? 基本的に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 (もこな2) 2018/04/01(日) 15:37
たぶん、これ「選択中のセル範囲」の間違いですよね
間違っていたらごめんなさいだけど、
アクティブセル・・・・・複数あることはない、単一セルしかありえない
選択中のセル範囲・・・・複数の連続しないセル範囲である場合もある。それぞれの連続するセル範囲は単一、複数どちらもありうる
だとおもうので、そこの辺も考えながら質問するとよいかもです。
(もこな2) 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
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.