こんにちはゲストさん。会員登録(無料)して質問・回答してみよう!

解決済みの質問

Excel数字を入力し画像を呼び出し(マクロ)

マクロを利用してコンピュータの指定ディレクトリに保存した画像(.png)を呼び出すマクロを使用しております。現在、特定の1箇所で動作するマクロとなっているため、これを応用して同シート内複数個所で同じ動作を行うマクロにすることは可能でしょうか?

例:現在 C3に数字(PCの指定フォルダに保存してある画像の名前)を入力>F3に画像が表示される
  希望 上記動作に加えてC5に数字(保存してある画像の名前)を入力>F5に画像が表示される
                 C6に数字を入力>F6に画像が表示される
                 C6に数字を入力>F7に画像が表示される..
. 
これが判りましたら応用で使用したいと考えております。
現在使用しているマクロです↓
=====================================================================
Private Sub Worksheet_Change(ByVal Target As Range)

Dim ファイル As String

If Intersect(Target, Range("C3")) Is Nothing Then Exit Sub

ActiveSheet.Shapes("画像").Delete

ファイル = "K:\te\" & Range("C3").Value & ".png" '←写真を保存したフォルダのパスに修正してください

Range("F3").Select
ActiveSheet.Pictures.Insert(ファイル).Select
Selection.ShapeRange.LockAspectRatio = msoTrue
Selection.ShapeRange.Height = 30.75
Selection.Name = "画像"

End Sub
================================================================

初心者で申し訳ございません。
お手数ですが、何卒よろしくお願いいたします。

投稿日時 - 2012-09-28 03:25:05

QNo.7720843

すぐに回答ほしいです

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

手順:
ご質問に書かれている現在のマクロを「漏れなく」消去する
改めて下記をコピー貼り付ける

private sub Worksheet_Change(byval Target as excel.range)
 dim h as range
 dim myPath as string
 dim myFile as string

 mypath = "K:\test\" ’実態に合わせて正しく修正のこと

 on error resume next
 for each h in application.intersect(target, range("C:C"))
  activesheet.shapes("画像" & h.address).delete

  myfile = h.value & ".png"

  if h <> "" then
   with activesheet.pictures.insert(mypath & myfile).shaperange
    .name = "画像" & h.address
    .lockaspectratio = msotrue
    .top = h.top
    .left = h.offset(0, 3).left
    .height = 30.75
   end with
  end if
 next
end sub


C列に番号を記入すると,F列に画像を挿入します。
番号を消去すると(間違った番号を記入すると)画像を消去します。

投稿日時 - 2012-09-28 14:37:15

お礼

すいません、お礼回答が反映されてなかったみたいです><
本当にありがとうございます!
試してみます!助かります。

投稿日時 - 2012-10-01 17:24:18

ANo.1

このQ&Aは役に立ちましたか?

0人が「このQ&Aが役に立った」と投票しています

回答(1)

あなたにオススメの質問