Выбор фото по табельным номерам

[Aqil_f]

Есть папка "фото", в ней .JPG файлы. Название всех .JPG файлов начинается с буквы "P". Допустим, вот так: P000020, P600255, P45874852 и т.д. По условиям эти .JPG файлы надо показать XLS файле в конктетном ячейке. Допустим, если выбран табельный номер 600255, тогда P600255 должен показатся на листе Excel. Помогите пожалуйста, как можно делать такое.

[Aqil_f]

Надо вставлять: на лист , на конкретное ячейке (допустим B10) и менять когда табельный номер меняется (табельный номер находится в B2)

[pashulka]

Укажите свою папку с фото и разместите строго в модуле нужного рабочего листа :

Private Sub Worksheet_Change(ByVal Target As Excel.Range)
    If Target.Address = "$B$2" Then 'Or Intersect()
       iFileName$ = "C:\Фото\P" & CStr(Target) & ".JPG"
       
       If Dir(iFileName$) <> "" Then
          Me.Pictures.Delete
          With Me.Range("B10")
               Me.Shapes.AddPicture iFileName$, msoFalse, msoTrue, .Left, .Top, .Width, .Height
          End With
       Else
          MsgBox "Файл изволит отсутствовать", vbCritical, ""
       End If
    End If
End Sub

P.S. Если на листе есть и другая графика, то вместо удаления всех картинок, имеет смысл удалять вполне конкретную.

[Aqil_f]

pashulka, большое спасибо, то что надо. Только, фотография на одну ячейку не помещается (очень маленький и ничего не видно). Я хотел обяденить несколько ячеек, но все равно не получается

[pashulka]

Aqil_f, Если замените .Width и .Height на -1 , то начиная с Excel2000 получите картинку в "натуральную величину"

P.S. Если же использование об'единённых ячеек необходимо, то оставьте первоначальный вариант, но с Me.Range("B10").MergeArea

[Aqil_f]

pashulka,
Мне больше подходит использование об'единённых ячеек , потому что натуральная величина картинки очень большой. Но я только что заметил что, если табельный номер не правильно написано, или В2 пусто, тогда картинка не удаляется. По этому я после Else добавил Me.Pictures.Delete. Это правильно?

[pashulka]

Можно просто удалять картинки(у) перед проверкой на существование файла ( If Dir(iFileName$) ... )

[Aqil_f]

pashulka, большое спасибо Вам. Все правильно работает.
Но, если можно, еще 1 вопрос: Табельный номер в ячейке если от руки писать, тогда все правильно работает. Но, в ячейке В2 у меня ссылка есть: B2=List4!C2.

Картинка обнавляется только тогда, когда если закрыть файл, и открыть еще раз. Или нажать ентер на самом ссылке. Как можно делать эта обнавления автоматически?

[pashulka]

1) Либо сохраните событие в модуле листа с именем List4, разумеется, не забыв заменить Лист1 на кодовое(программное) имя листа, где будет выводиться картинка.

Private Sub Worksheet_Change(ByVal Target As Excel.Range)
    If Target.Address = "$C$2" Then 'Or Intersect()
       iFileName$ = "C:\Фото\P" & CStr(Target) & ".JPG"
       
       If Dir(iFileName$) <> "" Then
          Лист1.Pictures.Delete
          With Лист1.Range("B10")
               Лист1.Shapes.AddPicture iFileName$, msoFalse, msoTrue, .Left, .Top, .Width, .Height
          End With
       Else
          MsgBox "Файл изволит отсутствовать", vbCritical, ""
       End If
    End If
End Sub

2) Либо попробуйте приспособить событие Worksheet_Calculate()

[Aqil_f]

Я хотел использувать 1-й вариант, но что-то у меня не получается. Посмотрите пример, пожалуйста. (картинка будет выводиться в List4.)