поиск карт(ки)
Модератор: Naeel Maqsudov
Добрый день.,
Подскажите мне пож,с чего начать а главное где закончить.
ЗАдумка простая, лист Excel
на нем море артикулов с товаром... ТО ЛИ по активации ячейки с артикулом, то ли по кнопке, но нужно найти и показать фото (артикул.jpg) которые находятся по пути
С:\Foto\
С уважением.
А еслли подвесить адрес (путь) к файлу на гипперссылку - не подойдет?
По клику на такую гиперссылку соответствующий файл откроется графическим редактором/просмотрщиком, зарегистрированным для этой ОС, как вызываемый по умолчанию для этого типа файла.
По клику на такую гиперссылку соответствующий файл откроется графическим редактором/просмотрщиком, зарегистрированным для этой ОС, как вызываемый по умолчанию для этого типа файла.
Всякое решение плодит новые проблемы.
вот хочется что-то типа вот такого,
Где Засада, или как улутшить, или может вообще в другую сторону
Код: Выделить всё
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, "Ошибка поиска картинки !?!"
-
- Сообщения: 17
- Зарегистрирован: 16 ноя 2007, 13:00
- Откуда: Ekaterinburg
- Контактная информация:
А в чем засада-то? Макрос вроде корректно работает - в ячейку 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, "Ошибка поиска картинки !?!"
Для красоты сделайте запуск макроса по двойному клику на ячейке с артикулом.
Что еще хотите?
ЗЫ Какая-то сомнительная для Экселя задача на мой взгляд. Т.е. выгрузка в на листы Экселя рисунков откуда-то.
кРАСОТУ НАВЕЛ
я ВОТ ДУМАЮ а если артикул вида 5372/05 то файло оно не найдет,(вернее файло там не обозвется.)
я мысль хочу уловить как лутше может индекс поставить???
все ведь не сложно но этим будут пользоваться, нужно чтоб без глюков.
С уважением!!!
Код: Выделить всё
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
я мысль хочу уловить как лутше может индекс поставить???
все ведь не сложно но этим будут пользоваться, нужно чтоб без глюков.
С уважением!!!
- VictorM
- Сообщения: 787
- Зарегистрирован: 23 окт 2006, 01:44
- Откуда: Lugansk, Ukraine
- Контактная информация:
Посмотрите вот это:
http://www.planetaexcel.ru/tip.php?aid= ... 88ff6620d6
http://www.planetaexcel.ru/tip.php?aid= ... 88ff6620d6
-
- Сообщения: 0
- Зарегистрирован: 27 сен 2015, 15:03
- Контактная информация:
покупаем дрова колотые
+380509607693
Skype Khrushch1
info@yk-wood.com
http://drevtorg.ning.com/main/search/se ... 0%B2%D0%B0
+380509607693
Skype Khrushch1
info@yk-wood.com
http://drevtorg.ning.com/main/search/se ... 0%B2%D0%B0