エクセル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

No.1 ベストアンサー 回答者： nishi6 回答日時： 2014/07/09 16:42

例えば、セルB9:B1000を入力できるようにする場合です。

Private Sub Worksheet_Change(ByVal Target As Range)

　　Const ImagePath = "C:\Users\f\Desktop\画像\"

　　If Target.Count <> 1 Or _
　　　　Application.Intersect(Target, Range("B9:B1000")) Is Nothing Then Exit Sub　　'■■修正

　　Application.EnableEvents = False

　　Dim codeRange As Range　　　　　　　'スペルミス？
　　Set codeRange = Target　　　　　　　　'■■修正

　　Dim picRange As Range
　　Set picRange = Target.Offset(0, -1)　　　'■■修正

　　Dim objPic As Picture


この程度で大丈夫かなと思います。

この回答への補足

有難うございます！思っている様なことが出来ました！

ちなみに、別のエクセルファイルから品番一覧をコピーして品番の列(B9)に貼りつけると画像が表示されないのですが、やはり手で入力するのとコピー&ペーストとではマクロコードは違うのでしょうか？

申し訳ないです。

補足日時：2014/07/09 17:40

この回答へのお礼

あいがとうございました！

お礼日時：2014/07/22 15:46

No.2 回答者： nishi6 回答日時： 2014/07/09 20:28

＞ちなみに、別のエクセルファイルから品番一覧をコピーして品番の列(B9)に貼りつけると画像が表示されないのですが、やはり手で入力するのとコピー&ペーストとではマクロコードは違うのでしょうか？

質問のコードの
　If Intersect(Target, Range("B9")) Is Nothing Then Exit Sub
と
　Set codeRange = Range("B9")
　Set picRange = Range("A9")

を見て、B9単一セルに対する処理と判断しました。かつ、「同じくB10,B11,B12・・・と下の行にも同じように品番を入力すれば」とあるので、単一セル入力と限定して解答しました。かつコピー&ペーストのパターンまで質問からは読み取れないので書きようがないわけです（A列、B列を一緒にコピペか、B列だけ複数とか）。

そのため、解答には、
　If Target.Count <> 1 Or Application.Intersect(Target, Range("B9:B1000")) Is Nothing Then
としています。複数セルの操作は「Target.Count <> 1」でキャンセルしています。
そのため、コピー&ペーストが単一セルの場合は動きますが、複数セルの場合はExitします。
一度、この部分を削除して動かしてみてはどうでしょうか。

コピー&ペーストのときというよりも、複数セルを操作したときにも対応するためには、

For　Each 単一セル　In Target

のようにして単一セル単位で処理するように変える必要があります。当然、意図しない複数セルを変更した場合、エラー対応や復帰の処理が必要になります。質問のコードを見ただけではなかなか手を付けられませんね。