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

質問

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

例：現在　C3に数字(ＰＣの指定フォルダに保存してある画像の名前)を入力＞F3に画像が表示される
　　希望　上記動作に加えてC5に数字(保存してある画像の名前)を入力＞F5に画像が表示される
　　　　　　　　　　　　　　　　　C6に数字を入力＞F6に画像が表示される
　　　　　　　　　　　　　　　　　C6に数字を入力＞F７に画像が表示される..
.　
これが判りましたら応用で使用したいと考えております。
現在使用しているマクロです↓
=====================================================================
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
================================================================

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

回答No.1

keithin · ベストアンサー

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

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

Ｃ列に番号を記入すると，Ｆ列に画像を挿入します。
番号を消去すると（間違った番号を記入すると）画像を消去します。

お礼

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