初心者です。お願いします！！

質問

はじめまして。真紀といいます。
ここ１月くらい悩みましたが、まったく答えがわからず、答えの探し方もわかりません。
どうか、このプログラムだけ、完成させてください．お願いします；；

シート１の（i,1)に写真を貼り付けると、サイズを補正して張り付き、
シート２の中から、シート１と同じ名前が付いているものを(i,1)から探して、見つけたらその２行目に書いてある数値を任意のセルに入力する。

このプログラムをいろんな人のホームページから探して書いたのですが、どうしても写真と同じ『名前』が分かりません。
教えてください＞＜。。。

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim selectRowNo As Long
Dim afile As Variant
Dim i As Long

Select Case Target.Column
Case 1
selectRowNo = Target.Row
Worksheets("sheet1").Activate
Worksheets("sheet1").Cells(selectRowNo, 1).Select
afile = Application.GetOpenFilename("bmpファイル (*.bmp), *.bmp", , , , True)
If IsArray(afile) Then
ActiveSheet.Pictures.Insert(afile).Select
Selection.ShapeRange.LockAspectRatio = msoTrue
Selection.ShapeRange.Height = 235.5
Selection.ShapeRange.Width = 385.5
End If

For i = 1 To 100
If Worksheets("sheet2").Cells(i, 1) = "" Then
Else

If Left(Worksheets("sheet2").Cells(i,1), Len("afile-THD")) = "afile-THD" Then
Worksheets("sheet1").Cells(Target.Row + 7, 11) 　　　　　　　　　　= Worksheets("sheet2).Cells(i, 2)
Exit For
End If
End If
Next

以上ですが、bmpは気にしないでください。
afile-THDの部分がいけないと思うのですが、拡張子が付いてるなまえだからいけないのかな？；；
よろしくお願いします＞＜

回答No.3

hana-hana3

＞しかし、残念ながらうまく動きません・・・；；

先に提示された条件（”写真の名前ーＴＨＤ”　と　”写真の名前ーＳＮ”を検索）とは検索するデータが異なっているからです。
他の文字は付かない前提でマクロを作成してあるので、提示された条件での動作しか想定していませんので・・・。

今回の補足では[.1000]が付加されているのでマクロを修正しないと検索出来ません。

Fline = Application.WorksheetFunction.Match(fname & "-SN.1000", Worksheets("sheet2").Range("A1:A100"), 0)
のように修正して見て下さい。

[.1000]の部分が変化している（固定ではない）ならこのマクロでは対応出来ませんし、必要な情報を提示して頂かない限り、提示された条件内でしかマクロを書く事は出来ません。

回答No.2

hana-hana3

実際の動作テストはしていませんが、こんな感じでいかがでしょうか？

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)

Dim afile As Variant
Dim fname As String
Dim find1 As String
Dim find2 As String
Dim Fline As Long

If Target.Column = 1 Then
Worksheets("sheet1").Activate
afile = Application.GetOpenFilename("bmpファイル (*.bmp), *.bmp", , , , False)
If afile <> False Then
ActiveSheet.Pictures.Insert(afile).Select
Selection.ShapeRange.LockAspectRatio = msoTrue
Selection.ShapeRange.Height = 235.5
Selection.ShapeRange.Width = 385.5

' "C:\xxxxxx\zzzzzz\PIC.bmp" の文字からファイル名("PIC")だけを取出す。
fname = Mid(afile, InStrRev(afile, "\") + 1, InStrRev(afile, ".") - InStrRev(afile, "\") - 1)

On Error Resume Next 'エラーを無視する。
'ワークシート関数（MATCH）を使って一致データを探す。
Fline = Application.WorksheetFunction.Match(fname & "-SN", Worksheets("sheet2").Range("A1:A100"), 0)
'見つかった行番号からデータを取得。
find1 = Worksheets("sheet2").Cells(Fline, 1)
Fline = Application.WorksheetFunction.Match(fname & "-THD", Worksheets("sheet2").Range("A1:A100"), 0)
find2 = Worksheets("sheet2").Cells(Fline, 1)

Cells(Target.Row + 7, 11) = find1 '"-SN" の結果
Cells(Target.Row + 7, 12) = find2 '"-THD"の結果

End If
End If

End Sub

補足

遅くなってすみません。
ご丁寧な対応ありがとうございます。

しかし、残念ながらうまく動きません・・・；；
検索して、拾っているのかどうかもわかりません。

見つかった行番号からデータを取得とありますが、
たとえば、
PIC.bmp　を貼り付け、
シート２は
PIC-THD.1000（12.1）
PIC-SN.1000 （13.1）
というのが分かったとしたときに、
結果（得たい数値）は必ず（12.2）と（13.2）にあります。

わがままですみません・・・

回答No.1

hana-hana3

＞シート１の（i,1)に写真を貼り付けると、

貼付ける写真は１回に１枚なのですか？
複数枚の貼付け（選択）にも対応するのですか？（同じ位置に貼付くので重なって仕舞います。）

＞afile-THDの部分がいけないと思うのですが、

名前の探し方が全く違っていますね。
見つかった名前の左から９文字（Len("afile-THD")=9）切り出して"afile-THD"という文字と比較しているだけの処理なので、貼付けたファイル名で比較できていません。

補足

こんなボロボロのプログラムに解凍していただきまして、本当にありがとうございます。

写真は１枚のみです。

もう少し細かく話しますと、シート１に貼り付けた写真の名前に
”写真の名前ーＴＨＤ”　と　”写真の名前ーＳＮ”
という似たような文字がシート２にあり、
それぞれを任意の場所に張り付けたいのですが、
似ているので、区別のつけ方とかが分からず、afile+”－ＴＨＤ”という物を探すようにしたいのですが、全然わかりません。。。

初心者でほんとにすみません。
プログラムのほとんどはホームページからとかの引用です。