• ベストアンサー

エクセルで、図を削除した時にセルの内容を変更するには

Excel97, Windows98SEを使用しています。 下記のようなマクロで、シートに写真を挿入しています。 例えば選択した写真が間違っていた時に、その写真を選択して 右クリック → 切り取り という操作をしますが、その時に、写真を挿入した際にセルに入力した文字列も自動的に消えるようにしたいのです。 Private Sub Worksheet_Activate() で、選択した写真の入っているセル番地を取得するのかな? と考えたのですがその先がわかりません。 ご存知の方、どうぞよろしくお願いいたします。 Sub 写真挿入() On Error GoTo エラー処理 写真パス = Application.GetOpenFilename '「ファイルを開く」ダイアログ表示・ファイル名取得 ActiveSheet.Pictures.Insert(写真パス).Select '図を挿入 With Selection .ShapeRange.LockAspectRatio = msoTrue '縦横比を固定する .ShapeRange.Height = 250 '写真の高さ .Name = "写真" '名前を付ける End With If Selection.Width < Selection.Height Then '縦長の写真だった場合 Selection.ShapeRange.IncrementLeft 72# '枠の中央に配置する End If ActiveCell.Offset(0, 1).Value = 写真パス '取得したフルパスを隣のセルへ入力 エラー処理: End Sub

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

  • ベストアンサー
回答No.3

#2です。 次のようにされるとよいでしょう。 NM = Selection.Name 位置 = ActiveSheet.DrawingObjects(NM).TopLeftCell.Address

takahiro_
質問者

お礼

ご回答どうもありがとうございます。 お陰様でうまくできました。 右クリック → 切り取り で同時に文字列を削除するのは難しそうですので、削除用ボタンを作って対応することになりました。 またわからない事がありましたらよろしくお願いいたします。

その他の回答 (2)

回答No.2

> 縦長の写真だった場合、枠の中央に配置する マクロを実行する前に選択するセルの形やサイズがわかりませんし、「枠」という ものが何なのかもわかりません。 位置 = ActiveSheet.DrawingObjects(1).TopLeftCell.Address で写真の左上端が位置するセルのアドレスを取得することはできますが、提示され たマクロですと、縦長の画像の場合に画像位置が右にずれてしまいますので、フル パスの入ったセルを特定できません。 次のようにして対処することはできないのでしょうか。 図を表示すると同時に、その右上端を基点としたテキストボックスを自動的に作成 しフルパスを表示して画像とグループ化する処理です。 ActiveCell.Offset(0, 1).Value = 写真パス の一行を、次の内容に入れ換えます。 TP = Selection.Top LF = Selection.Left WD = Selection.Width ActiveSheet.Shapes.AddTextbox(msoShapeRectangle, LF + WD, TP, 1#, 1#). _ Select With Selection .Characters.Text = 写真パス .ShapeRange.Fill.Visible = msoFalse .ShapeRange.Line.Visible = msoFalse .AutoSize = True .Name = "パス" 'フルパスを名前にする End With ActiveSheet.Shapes.Range(Array("写真", "パス")).Select Selection.ShapeRange.Group.Select

takahiro_
質問者

お礼

ご回答どうもありがとうございます。 説明不足でしたようですみません。 作っているものは工事用の写真アルバムで、 写真を入れる「枠」は、9R×21Cのセルを結合したもので、大きさは縦が250(写真の縦の長さ)で、横が一般的な横向きのデジカメ写真の比率とほぼ同じ幅になっています。 横長の写真ならほぼそのセル内に収まり、縦長の写真も選択したセル内からははみ出ないようになっています。 > 位置 = ActiveSheet.DrawingObjects(1).TopLeftCell.Address 教えていただきましたコードですと、どうしてもシートの一番上にある図形のアドレスしか取得できませんでした…。 ハンドルの付いた画像、もしくは削除される画像のアドレスを取得する方法はありませんでしょうか? どうぞよろしくお願いいたします。

  • imogasi
  • ベストアンサー率27% (4737/17068)
回答No.1

多分私には回答する力がないのですが 「シートに挿入した画像を削除したとき、それをイベントとして捉える」方法と言うことになるのではと思いました。 もしそうであれば、自分のコーディングを上げておられますが、それが妨げ(読むのが煩わしく、焦点がぼやけて)となって、回答出来るひとが、振り向いてくれない惧れがあります。 エクセルVBAレベルでは、イベントの主体として認めてくれているのは、シートやコントロールなど極く限定的で シート上に見えるもの色々を対象にしてイベントを捉えるには、APIレベル(ウインドウ・メッセージレベル)の研究が必要なのではと想像しています。コントロールの集合のイベント(ボタンが沢山あって、どれかクリックすると何かしたい)などで、クラス化などの説明も見たことがありました(大村あつしさんの本)。

takahiro_
質問者

補足

ご回答どうもありがとうございます。 > 「シートに挿入した画像を削除したとき、それをイベントとして捉える」方法 仰る通りです。でも手持ちのVBAの本を読みましたところ、シートやブック、コントロールのイベントはありますが、オートシェイプにはなさそうでしたので、シートのイベントでどうにかする方法があればいいなと思って質問いたしました。 質問内容は、できるだけ回答して頂ける方が補足を必要としないように心掛けて書いたつもりでしたが、蛇足だったようですね。反省しております。 お手数をおかけしまして申し訳ありませんでした。

関連するQ&A

  • コメント挿入マクロ挿入位置ずれの件

    コメント挿入マクロ挿入位置ずれの件 エクセル2007 ウインドウズ7利用 エクセルセル内の品番に対し別ファイルに保存してある同じ品番の画像をセルに挿入するマクロを組んで頂いたのですが品番を記載したセルからずれた所に画像が挿入されます。 挿入する画像が数百枚単位となりますので現在全画像を選択して移動するのも時間がかかってしまいます。品番が記載されたセルへ挿入する方法があれば教えていただけますでしょうか。 記 Sub 画像挿入() Dim 対象セル As Range For Each 対象セル In Selection If Dir("C:\画像\" & 対象セル.Value & ".jpg") <> "" Then '該当するファイルがあれば ActiveSheet.Pictures.Insert("C:\画像\" & 対象セル.Value & ".jpg").Select Selection.ShapeRange.LockAspectRatio = msoFalse Selection.ShapeRange.Height = 対象セル.Height Selection.ShapeRange.Width = 対象セル.Width Selection.ShapeRange.IncrementLeft 対象セル.Left Selection.ShapeRange.IncrementTop 対象セル.Top End If Next 対象セル End Sub です。宜しく御願い致します。

  • セルの値をテキストボックスへ記入及び名前変更

    範囲選択したセルに丸オートシェイプを挿入すると共に、それぞれのセルの値をテキストで追加及び、図形名を同じ値にしたいと思っています(下記の***の部分)。この時セルは結合されている場合があります。 描写は下記のようにしたのですが、セルの読み込みで詰まってしまいました。セルの値を読み込むにはどの様なしたらいいのでしょうか? 宜しくお願い致します。 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

  • エクセル2007でマクロを使った写真挿入がうまくいきません。

    エクセル2007でマクロを使った写真挿入がうまくいきません。 エクセル2003で使っていたひな形をもらったのですが2007では結合したセルから ずれてしまいます。 どうすれば位置の修正をできますか? また、結合した大きなセルの中にフォームボタンを付けいるのですが 2003では写真が挿入されるとボタンは隠れてしまっていたのですが、 2007では挿入した写真に重ねって写真が見ずらいです。 隠すことはできるのでしょうか? なにぶん初心者なのでお願いします。 Sub Pic_in() ' マクロ記録日 : 2003/7/1 kome fname = Application.GetOpenFilename ActiveSheet.Pictures.Insert(fname).Select Selection.ShapeRange.LockAspectRatio = msoFalse Selection.ShapeRange.Height = 247.5 Selection.ShapeRange.Width = 350 End Sub

  • EXCELのVBAによる写真貼り付け時に重なる。

    VBAの初心者です。 エクセルに写真データを貼り付けるVBAで、以下のマクロを実行するとシートの同じセル位置B5に、写真が2枚重なった状態となります。 セルのB5とH5の位置に写真をそれぞれ貼りつけるために、どのように修正すればよいのでしょうか?ご教授ください。 OS:Vista ソフト:Excel2007 Sub 写真ファイル呼び出し() ' Sheets("風景1").Select Range("B5").Select ActiveSheet.Pictures.Insert(Worksheets("風景写真").Range("o4").Value).Select With Selection Selection.ShapeRange.LockAspectRatio = msoTrue '縦横比を固定するコマンド Selection.ShapeRange.Width = 245 '縦横比固定、幅のみを指定する End With 'Sheets("風景2").Select Range("H5").Select ActiveSheet.Pictures.Insert(Worksheets("風景写真").Range("o5").Value).Select With Selection Selection.ShapeRange.LockAspectRatio = msoTrue '縦横比を固定するコマンド Selection.ShapeRange.Width = 245 '縦横比固定、幅のみを指定する End With End Sub

  • Excel2007 VBAで画像挿入について

    Sub 図形挿入等倍() Dim FilePath As Variant FilePath = Application.GetOpenFilename(",*.png") If Not FilePath = False Then ActiveSheet.Pictures.Insert(FilePath).Select Selection.ShapeRange.LockAspectRatio = msoTrue Selection.ShapeRange.Width = Selection.ShapeRange.Width * 1# Selection.ShapeRange.Left = ActiveCell.Left + 2.25 Selection.ShapeRange.Top = ActiveCell.Top + 2.25 End If With Selection.ShapeRange.Line .Weight = 2.25 '線の太さを2.25に .ForeColor.RGB = RGB(255, 0, 0) '赤枠に End With End Sub 上記のコードを書き、画像を挿入したときは問題ないのですが 画像を挿入せずにキャンセルすると 実行時エラー438 オブジェクトは、このプロパティまたはメソッドをサポートしていません。とでてしまいます デバックをしてみると With Selection.ShapeRange.Lineの部分が黄色くなっているので ここを修正したらいいと思うのですが どのように修正したらいいのか分かりません お分かりの方いましたらご教授お願い致します

  • エクセルに画像を貼付け縮小する作業をマクロにしたいのですが、

    エクセルに画像を貼付け縮小する作業をマクロにしたいのですが、 分からない部分があって困ってます。 (1)挿入したいセルにカーソルを合わせる (2)マクロ  挿入-図-ファイル-図の挿入-図の書式設定-サイズ-30% この作業を覚えさせると以下になりました。 Sub Macro3() ActiveSheet.Pictures.Insert("C:\Documents and Settings\デスクトップ\1.JPG") _ .Select Selection.ShapeRange.LockAspectRatio = msoTrue Selection.ShapeRange.Height = 360# Selection.ShapeRange.Width = 480# Selection.ShapeRange.Rotation = 0# End Sub これだと、写真が指定されてしまいます。 マクロの途中で止まって任意の写真を都度選べるようにできますか? 膨大な量の写真をセルに並べていきたいのです。

  • Excel 任意のセルを指定する方法

    Excel 任意のセルを指定する方法 こんにちは Excel2003でセルの上を「---」で覆うマクロを作成しました。(以下参照) でもこれはセル「K2」に作成されます。 任意の作成したいセルを「---」で覆うようにするのには どのように改造すればよいでしょうか? おわかりの方お教えください。 ' 透明なセルを一つ作るマクロ ActiveSheet.Shapes.AddTextbox(msoTextOrientationHorizontal, 672.75, 13.5, _ 81#, 13.5).Select Selection.Characters.Text = "---" With Selection.Characters(Start:=1, Length:=3).Font .Name = "MS Pゴシック" .FontStyle = "標準" .Size = 11 .Strikethrough = False .Superscript = False .Subscript = False .OutlineFont = False .Shadow = False .Underline = xlUnderlineStyleNone .ColorIndex = xlAutomatic End With Selection.HorizontalAlignment = xlCenter Selection.ShapeRange.Fill.Visible = msoFalse 'Selection.ShapeRange.Fill.Solid 'Selection.ShapeRange.Fill.Transparency = 0# Selection.ShapeRange.Line.Weight = 0.75 Selection.ShapeRange.Line.DashStyle = msoLineSolid Selection.ShapeRange.Line.Style = msoLineSingle Selection.ShapeRange.Line.Visible = msoFalse Range("K2").Select End Sub

  •  エクセルに写真を挿入するマクロを組んでいます。

     エクセルに写真を挿入するマクロを組んでいます。 2003までは問題なく動作していたマクロが、 2007では位置調整がうまく行きません。  そこでネットで検索して With Selection .Left = Range("C6").Left .Top = Range("C" & rowa).Top End With のように Selection.Left を使えば解決するとありましたが、 (1)WIN VISTAのエクセル2007では おなじひとつのエクセルファイルの あるシートではコード通りが位置でるのに 違うシートでは縦位置がずれる。 (2)WIN XPのエクセル2007では すべてのシートで縦位置がずれる。 ただし、ずれの位置は(1)よりは少ない。 といずれのOSでも不具合が出ます。  事情によりエクセル2007でこのマクロを使用しなければならなくなり 非常に困っております。 どなたか解決方法をご存知の方、よろしくお願いします。  なお、(2)のWIN XPでは、エクセル2003も入っており、 その中では、全く問題なくマクロが動作しています。 実際のコードは下の通りです。 Sub 写真呼出(koumoku, jpgf, tr As Variant) Dim rowa As String ActiveWindow.ScrollColumn = 1 ActiveWindow.ScrollRow = tr ←選択したセルの行ナンバー ActiveSheet.Pictures.Insert(motopath & "写真\" & koumoku & "\" & jpgf & ".JPG").Select Selection.Name = "写真" Selection.ShapeRange.LockAspectRatio = msoTrue '縦横比の固定 Selection.ShapeRange.Height = 480 'Selection.ShapeRange.IncrementLeft 100 ←不具合が出たので止めた部分 'Selection.ShapeRange.IncrementTop 40  ←不具合が出たので止めた部分 rowa = tr + 2 With Selection .Left = Range("C6").Left .Top = Range("C" & rowa).Top End With End Sub

  • 【エクセル】矢印のサイズ変更

    いつもお世話になっております。 計画表を作成するにあたり、行き詰ってしまったので 参考のサイトやアドバイスを教えて頂きたいです…。 まず図でいくと右上にあります【選択したセルに矢印を引く】をクリックしますと 選択したセルに矢印が引かれます。 そのプログラムは以下のようになってます。 Sub Test() Dim TP, LF, WD TP = Selection.Top + (Selection.Height / 2) LF = Selection.Left WD = Selection.Width ActiveSheet.Shapes.AddLine(LF + 0, TP, LF + WD, TP).Select '始点のスタイル Selection.ShapeRange.Line.BeginArrowheadStyle = msoArrowheadShort '終点のスタイル Selection.ShapeRange.Line.EndArrowheadStyle = msoArrowheadTriangle End Sub しかし矢印の三角部分が大きいので、これを一番小さいスタイルの矢印へ 変更したいのですが・・・うまく変更されません。 どう修正すれば変更されるのでしょうか。 わかる方いらっしゃいましたら教えて頂きたいです。 プログラムは同じような用途のものでしたら どんなのでも有り難いです。 宜しくお願い致します。

  • VBAで画像を自動で切り替える方法

    Excelで棚割表を作っています。商品コードを打つとその商品の画像を自動で表示させたいのですが、雑誌を見ながらコードをアレンジしてほぼ完成したのですが、「プロシージャーが大きい」とエラーが出てマクロを実行出来ません。 画像は100個程度あり、先に別のマクロで貼り付けてあります。 Private Sub Worksheet_Change(ByVal Target As Range) Dim ファイル As String If Intersect(Target, Range("A4")) Is Nothing Then ActiveSheet.Shapes("画像").Delete ファイル = "C:\保存場所\" & Range("A4").Value & ".jpg" Range("B5").Select ActiveSheet.Pictures.Insert(ファイル).Select Selection.ShapeRange.LockAspectRatio = msoTrue Selection.ShapeRange.Top = ActiveCell.Top Selection.ShapeRange.Left = ActiveCell.Left Selection.ShapeRange.Height = 97 Selection.ShapeRange.Width = 52.5 Selection.ShapeRange.Rotation = 0# Selection.ShapeRange.IncrementLeft 1.5 Selection.ShapeRange.IncrementTop 1.5 Selection.Name = "画像" End If (中略) Dim ファイル98 As String If Intersect(Target, Range("U60")) Is Nothing Then Exit Sub ActiveSheet.Shapes("画像98").Delete ファイル98 = "C:\保存場所\" & Range("U60").Value & ".jpg" Range("V61").Select ActiveSheet.Pictures.Insert(ファイル98).Select Selection.ShapeRange.LockAspectRatio = msoTrue Selection.ShapeRange.Top = ActiveCell.Top Selection.ShapeRange.Left = ActiveCell.Left Selection.ShapeRange.Height = 97 Selection.ShapeRange.Width = 52.5 Selection.ShapeRange.Rotation = 0# Selection.ShapeRange.IncrementLeft 1.5 Selection.ShapeRange.IncrementTop 1.5 Selection.Name = "画像98" End Sub 省ける箇所や分割する方法などありましたら教えてください。

専門家に質問してみよう