マイピクチャーから画像を引っ張る

質問

マイピクチャーから画像を引っ張る

エクセルシートのA2セルに「125-1」と入れたら、マイピクチャーから「125-1」というタイトルのついた画像をB2セルに表示する、ということをA3-B3,A4-B4・・・と繰り返し表を作りたいです。

下記を参考にしましたが、A2-B2は出来ますが、それ以降をどう設定したらいいのか分りません。
ご指導ください。

http://okwave.jp/qa/q1500030.html

回答No.3

imogasi

VBA初心者らしいが、なぜ「マクロの記録」をやってみないのか不思議。
それで大枠のコードはわかる。
挿入ー図ーファイルから、の操作をしてマクロの記録を採る。
そして写真などのシートの画像の大きさを修正する。（これもマクロの記録が参考になるがセルの大きさに閉じ込める方法もある）
Sub Macro1()
ActiveSheet.Pictures.Insert( _
"C:\Documents and Settings\XXXX￥My Documents\My Pictures\XXXXX\XXXXXXX.JPG"). _
Select
Selection.ShapeRange.ScaleWidth 0.51, msoFalse, msoScaleFromTopLeft

End Sub
これでは左上隅がActiveCellに位置するようだから
Range("B2 ").Select　を入れる。
画像ファイルは、上記では人間が指定したがInsert（）の（）内に画像の在り処のフルパスの文字列を
作る。その際Range("A1").ValueやCells(1,"A").Valueをその一部に織り込んで使う（というかA2の文字列では、既定省略した部分が、フルパス的にはあるのだがその部分は＆で文字列を結合し補う）。
後はRange("B2 ").Select　やA列セルを変化させるプログラムに変えて
行数分（回）だけForNextなどで繰り回す。
結局、質問者の段階では、マクロの記録の応用を拡げる訓練をしっかりすることが必要。
＞A2セルに「125-1」と入れたら
こういう動的に即反応する、の記述になっているが、どうなんですか。
A2,A3、A4,・・終わりまで入れて、そこで写真を隣のセルに一斉に入れて終わりで良いのか。
A列セルで指定行が増えた（入力済み行が増えた）とき、またこのプログラムを少々変えて実行しても良いのか。
それによってイベントで処理するかどうかが決り、そこがポイント。出来ればイベントは使わないほうが安定して、かつ易しい。
また参考過去質問の回答のどちらを念頭に置いて居るか、書いておくべきです。

回答No.2

mar00

Sub Macro1()　 ここを削除
For i = 2 To Cells(1, Columns.Count).End(xlToLeft).Column
For i = 2 To・・・はPrivate Sub・・・ のしたに入れる

Private Sub Worksheet_Change(ByVal Target As Range)
For i = 2 To Cells(1, Columns.Count).End(xlToLeft).Column
・
・
・
Application.ScreenUpdating = True
End Sub ここを削除
Next i
End Sub

回答No.1

mar00

たぶん2番目の回答を参考にしていると思うのですが
違っていたら無視してください。
Sub Macro1()
For i = 2 To Cells(1, Columns.Count).End(xlToLeft).Column
現在の処理
Next i
End Sub
のようにして、現在の処理の
"A2"を"A"&iに、"B2"を"B"&iにすればできるのではないかと
思います。

補足

ありがとうございます。

２番目の回答を参考にして下記のように設定しました。

'
Private Sub Worksheet_Change(ByVal Target As Range)
Dim PathName, FileName
If Target.Address <> "$A$2" Then Exit Sub
Application.ScreenUpdating = False
On Error Resume Next
ActiveSheet.Shapes("Pic").Cut
If Target.Value = "" Then
Range("A2").Select
GoTo Fin
End If
PathName = "C:\test\Image"

FileName = PathName & "\" & Dir$(PathName & "\" & Target.Value & ".*")
Range("C2").Select
ActiveSheet.Pictures.Insert(FileName).Select
Selection.ShapeRange.LockAspectRatio = msoTrue
Selection.ShapeRange.Height = 50
Selection.Name = "Pic"
Range("A2").Select
Fin:
Application.ScreenUpdating = True
End Sub

教えて頂いたように、下記のようにしましたがエラーがでます。
入れ方を間違えてるでしょうか？

'
Sub Macro1()
For i = 2 To Cells(1, Columns.Count).End(xlToLeft).Column

Private Sub Worksheet_Change(ByVal Target As Range)
　　Dim PathName, FileName
　　If Target.Address <> "A"&i Then Exit Sub
　　Application.ScreenUpdating = False
　　On Error Resume Next
　　ActiveSheet.Shapes("Pic").Cut
　　If Target.Value = "" Then
　　　　Range("A"&i).Select
　　　　GoTo Fin
　　End If
　　PathName = "C:\test\Image"

　　FileName = PathName & "\" & Dir$(PathName & "\" & Target.Value & ".*")
　　Range("C"&i).Select
　　　　ActiveSheet.Pictures.Insert(FileName).Select
　　　　Selection.ShapeRange.LockAspectRatio = msoTrue
　　　　Selection.ShapeRange.Height = 80　　
　　　　Selection.Name = "Pic"
　　Range("A"&i).Select
Fin:
　　Application.ScreenUpdating = True
End Sub
Next i
End Sub