- ベストアンサー
図形消去後に文字入力(エクセル）
Sub test() Dim c As Range If Not TypeName(Selection) = "Range" Then Exit Sub For Each c In Selection With c.MergeArea wTop = .Top wLeft = .Left wBottom = .Top + .Height wRight = .Left + .Width End With For Each s In ActiveSheet.DrawingObjects With s If wTop <= .Top And _ wLeft <= .Left And _ wBottom >= .Top + .Height And _ wRight >= .Left + .Width Then .Delete End If End With Next Next End Sub 上記マクロは、選択状態になっている個々のセルの中に、すっぽり収まる状態で存在しているオブジェクトを消去します。 オブジェクトが消去されたセルに、"○"が入力されるようにしたいのですが。 どういった記述が必要になるでしょうか？
- みんなの回答 （2）
- 専門家の回答
関連するQ&A
- エクセル２００７のVBAの困りごと
教えてください。 画像挿入時にエクセルのセルの大きさに合わせるマクロを使っているのですが、エクセル２０００、２００３では問題なく動くのですが、２００７だと、うまくVBAが動かず、画像が縮小・拡大されません。 わかるかた教えてください。 コード Dim c As Range, cm As Range Application.ScreenUpdating = False For Each c In Selection Set cm = c.MergeArea If c.Address = cm.Item(1).Address Then If Application.Dialogs(xlDialogInsertPicture).Show = False Then Exit Sub With Selection .Left = cm.Left .Top = cm.Top .Height = cm.Height .Width = cm.Width End With End If Next Set cm = Nothing
- 締切済み
- オフィス系ソフト
- 指定範囲をアクティブセルに変更(エクセル)
以下のマクロで、A1:E20にある全ての図形を削除できます。 Sub test() Dim wLeft As Long Dim wTop As Long Dim wRight As Long Dim wBottom As Long Dim s As Object With Range("A1:E20") wTop = .Top wLeft = .Left wBottom = .Top + .Height wRight = .Left + .Width End With For Each s In ActiveSheet.DrawingObjects With s If wTop <= .Top And _ wLeft <= .Left And _ wBottom >= .Top + .Height And _ wRight >= .Left + .Width Then .Delete End If End With Next End Sub "With Range("A1:E20")"を、任意のアクティブセルに変更するにはどうすればいいでしょうか？ ちなみに、"With ActiveCell"や"With Range(ActiveCell.Address)"では、うまくいきませんでした。
- ベストアンサー
- オフィス系ソフト
- Excelの写真貼り付け(90度回転)について
xcelに写真のサイズを自動的に変更するマクロ、(セルの大きさに合わせて）を利用しています。 このマクロに対して写真を90度角度を変更して、写真を表示させたいのですが、どのようにすればよいのでしょうか？ Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, _ Cancel As Boolean) ActiveSheet.Unprotect Dim C As Range, cm As Range Application.ScreenUpdating = False For Each C In Selection Set cm = C.MergeArea If C.Address = cm.Item(1).Address Then If Application.Dialogs(xlDialogInsertPicture).Show = False Then Exit Sub With Selection .Left = cm.Left .Top = cm.Top .Height = cm.Height .Width = cm.Width End With End If Next Set cm = Nothing Application.ScreenUpdating = True Range("a1").Select End Sub
- 締切済み
- その他MS Office製品
- エクセルでの画像貼り付け時のサイズ変換
エクセルについて教えてください。 ペイントソフトなどで画像修正したあと、そのままコピー（クリップボードに）し、エクセルに任意の大きさで貼り付けたいのですが、そんなマクロできるでしょうか。 方法としては、自分が貼り付けたい大きさに結合したセルを選択し、貼り付け（クリップボードなので、右クリック貼り付け）をすると、そのセルの大きさに自動で縮小・拡大するような仕組みです。 いろいろな掲示板を見て、クリップボードからではなく、挿入から画像を選んで任意のセルの大きさで貼り付けるというマクロは発見できました。 それをちょっといじるとできそうな気がするんですが、なにぶん詳しくないもので、、、 だれかわかる方教えてください。 ↓挿入からセルの大きさに合わせて貼り付けるマクロ Sub haritukeru() Dim c As Range, cm As Range Application.ScreenUpdating = False For Each c In Selection Set cm = c.MergeArea If c.Address = cm.Item(1).Address Then If Application.Dialogs(xlDialogInsertPicture).Show = False Then Exit Sub With Selection .Left = cm.Left .Top = cm.Top .Height = cm.Height .Width = cm.Width End With End If Next Set cm = Nothing Application.ScreenUpdating = True 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.を打ち込んでいたら、 「コンパイルエラー：プロシージャが大きすぎます」とエラーが出てしまいました。 ループさせればよいのだろうと試してみたのですが、元のセルの指定方法や、オートシェイプの出現させるせるの指定方法がわかりません。 どのようにすれば、データー元の範囲を指定して、それに対応したセルにオートシェイプを出現させる事が出来るようになるでしょうか。 お知恵を貸していただけないでしょうか。よろしくお願い致します。
- ベストアンサー
- その他MS Office製品
- エクセルで図形の削除
シート内に作図されている線で、 100 < .Height < 200 And 100 < .Width < 200 上記の条件を満たすものを削除したいのですが、以下のマクロですと、全ての線が削除されてしまいます。 シート内に様々な長さ・向きの線を作図して試したのですが。 For Each x In ActiveSheet.DrawingObjects With x If 100 < .Height < 200 And 100 < .Width < 200 Then .Delete End If End With Next どこがおかしいでしょうか？ ご指摘お願いします。
- ベストアンサー
- オフィス系ソフト
- セルの値をテキストボックスへ記入及び名前変更
範囲選択したセルに丸オートシェイプを挿入すると共に、それぞれのセルの値をテキストで追加及び、図形名を同じ値にしたいと思っています（下記の＊＊＊の部分）。この時セルは結合されている場合があります。 描写は下記のようにしたのですが、セルの読み込みで詰まってしまいました。セルの値を読み込むにはどの様なしたらいいのでしょうか？ 宜しくお願い致します。 Sub 選択されたセルに丸テキスト挿入() Dim X As Double Dim Y As Double Dim L As Double Dim c As Range If Not TypeName(Selection) = "Range" Then Exit Sub For Each c In Selection With c.MergeArea If c.Address = .Item(1).Address Then L = IIf(.Width > .Height, .Height, .Width) X = .Left + (.Width - L) / 2 Y = .Top + (.Height - L) / 2 ActiveSheet.Shapes.AddShape(msoShapeOval, X, Y, L, L).Select Selection.Name = ＊＊＊ Selection.Characters.Text = "＊＊＊" Selection.ShapeRange.Fill.Visible = msoFalse Selection.HorizontalAlignment = xlCenter With Selection.Characters(Start:=1, Length:=3).Font .Size = 8 End With End If End With Next End Sub
- ベストアンサー
- オフィス系ソフト
- VBAにて写真貼り付け
EXCEL2010を使用しています。 Ｄ3に於いて名前を選択できるようにしています。Ｄ3に入力する名前と同一の写真（JPG)がDISK TOP上フォルダー内に複数あります。 Ｄ3で名前選択時,該当する写真をA5:M29に表示したい。 以下のコードは他の方が使われてるコードを参考にしたもので、※印の場所でエラーとなります何が 原因なのか？他の部分も合わせ教えて下さい。 Private Sub Worksheet_Change(ByVal Target As Range) If Target.Address = "$D$3" Then myPath = "C:\Users\Users\DeskTop\PHOT" myFile = myPath & Range("D3").Text & ".jpg" For Each sh In ActiveSheet.Shapes If Left(sh.Name, 7) = "Picture" Then sh.Delete End If Next Range("A5:M29").Select myTop = Selection.Top myLeft = Selection.Left myWidth = Selection.Width myHeight = Selection.Height ※ActiveSheet.Pictures.Insert(myFile).Select With Selection .Top = myTop .Left = myLeft .Width = myWidth '画像の幅 .Height = myHeight '画像の高さ End With Range("D3").Select End If End Sub
- ベストアンサー
- Visual Basic
- エクセル2007のマクロについて
B9に品番を入力するとA9に画像が自動挿入される所まではなんとか出来たのですが、 同じくB10,B11,B12・・・と下の行にも同じように品番を入力すれば画像が自動挿入される様にするには,どうのようにすれば良いのでしょうか？宜しくお願い致します。 A B 9 画像 品番 10 画像 品番 11 画像 品番 12 画像 品番 ・ ・ ・ Private Sub Worksheet_Change(ByVal Target As Range) Const ImagePath = "C:\Users\f\Desktop\画像\" If Intersect(Target, Range("B9")) Is Nothing Then Exit Sub Application.EnableEvents = False Dim codRange As Range Set codeRange = Range("B9") Dim picRange As Range Set picRange = Range("A9") Dim objPic As Picture For Each objPic In ActiveSheet.Pictures If objPic.Left >= picRange.Left And objPic.Left <= picRange.Left + picRange.Width _ And objPic.Top >= picRange.Top And objPic.Top <= picRange.Top + picRange.Height Then objPic.Delete Exit For End If Next picPath = ImagePath & codeRange.Value & ".jpg" If Dir(picPath, vbNormal) = "" Then picRange.Cells(1, 1).Value = "画像がありません" Else picRange.Select Sheets(1).Pictures.Insert(picPath).Select '画像ファイルの挿入 With ActiveSheet.Pictures(ActiveSheet.Pictures.Count).ShapeRange .LockAspectRatio = msoFalse .Parent.Visible = msoTrue .Left = picRange.Left .Top = picRange.Top .Height = picRange.Height .Width = picRange.Width End With picRange.Cells(1, 1).Value = "" End If Application.EnableEvents = True End Sub
- 締切済み
- オフィス系ソフト
- Excel マクロ 入力があったらボタンを出したい
C3に入力があった場合、隣にボタンを表示させたいと考えています。 http://www.cocoaliz.com/excelVBA/index/17/ のようなサイトを参考に、以下のコードを書いてみました。 Private Sub Worksheet_SelectionChange(ByVal Target As Range) If Target.Address = "$C$3" Then If Not Range("C3") = "" Then With ActiveSheet.Buttons.Add(Range("D2").Left + 1, Range("D2").Top + 1, _ Range("D2:D3").Width - 1, Range("D2:D3").Height - 1) .OnAction = "あいうえお" .Characters.Text = "あいうえお" .Font.Size = 10 End With End If End If こうした場合、元々C3に何か入力されていると、 C3をSelectする度にボタンが作られてしまいます。 又、C3の内容を変更してEnterを押したり、他のセルをセレクトしても何も起きません。 C3に何か入力してEnter、又は他のセルをSelectした時のみボタンを表示させたいのですが、 何かいい方法ありますでしょうか？ よろしくお願いいたします。
- ベストアンサー
- オフィス系ソフト
お礼
ご指摘の方法で解決しました。 有難うございます。