Код: Выделить всё
Private Sub red()
Dim poz
poz = ActiveCell.Value
qwet = MsgBox("Вы ищите картинку - " & poz, vbYesNo)
If qwet = vbNo Then Exit Sub
ActiveCell.Copy Cells(65536, 256)
On Error GoTo Findler
ActiveSheet.Shapes(1).Delete
Range("S1").Select
'ActiveSheet.Pictures.Insert("C:\FOTO_JEL\" & TextBox1.Value & ".jpg").Select
ActiveSheet.Pictures.Insert("C:\FOTO_JEL\" & Cells(65536, 256).Value & ".jpg").Select
Exit Sub
Findler:
MsgBox "Фото выделенного Артикула1 - НЕТ в БАЗЕ Данных!" _
& vbCrLf & " Обратитесь к Администратору.", vbInformation, "Ошибка поиска картинки !?!"А в чем засада-то? Макрос вроде корректно работает - в ячейку S1 вставляет картинку. Че надо-то еще?DzenDen1 писал(а):вот хочется что-то типа вот такого,
Где Засада, или как улутшить, или может вообще в другую сторонуКод: Выделить всё
Private Sub red() Dim poz poz = ActiveCell.Value qwet = MsgBox("Вы ищите картинку - " & poz, vbYesNo) If qwet = vbNo Then Exit Sub ActiveCell.Copy Cells(65536, 256) On Error GoTo Findler ActiveSheet.Shapes(1).Delete Range("S1").Select 'ActiveSheet.Pictures.Insert("C:\FOTO_JEL\" & TextBox1.Value & ".jpg").Select ActiveSheet.Pictures.Insert("C:\FOTO_JEL\" & Cells(65536, 256).Value & ".jpg").Select Exit Sub Findler: MsgBox "Фото выделенного Артикула1 - НЕТ в БАЗЕ Данных!" _ & vbCrLf & " Обратитесь к Администратору.", vbInformation, "Ошибка поиска картинки !?!"
Код: Выделить всё
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
'Sub redUALING()
'Dim poza As Object
Dim sh As Shapes, s As Shape
poz = ActiveCell.Value
qwet = MsgBox("Вы ищите картинку - " & poz, vbYesNo)
If qwet = vbNo Then Exit Sub
ActiveCell.Copy Cells(65536, 256)
ActiveSheet.Pictures.Delete
On Error GoTo Findler
Range("S1").Select
ActiveSheet.Pictures.Insert("C:\FOTO_JEL\" & Cells(65536, 256).Value & ".jpg").Select
'ActiveSheet.Pictures.Insert("C:\FOTO_JEL\" & ActiveCell.Value & ".jpg").Select
Selection.ShapeRange.ScaleWidth 0.5, msoFalse, msoScaleFromTopLeft
Selection.ShapeRange.ScaleHeight 0.5, msoFalse, msoScaleFromTopLeft
Exit Sub
Findler:
MsgBox "Фото выделенного Артикула1 - НЕТ в БАЗЕ Данных!" _
& vbCrLf & " Обратитесь к Администратору.", vbInformation, "Ошибка поиска картинки !?!"
End Sub