Всем привет! Есть сводная таблица, получающая данные при открытии из внешней базы MS SQL. Полученный набор данных содержит информацию о товаре (характеристики, фин. показатели и пр.), среди которых есть ссылка на фото продукции. Задача вывести фото в примечание одной из ячеек на этапе загрузки данных из внешнего источника (как в вложении). Что бы для пользователя это было прозрачно. Буду признателен за помощь!
Всем привет! Есть сводная таблица, получающая данные при открытии из внешней базы MS SQL. Полученный набор данных содержит информацию о товаре (характеристики, фин. показатели и пр.), среди которых есть ссылка на фото продукции. Задача вывести фото в примечание одной из ячеек на этапе загрузки данных из внешнего источника (как в вложении). Что бы для пользователя это было прозрачно. Буду признателен за помощь!Marrex
Код нашёл на другом форуме меньше чем за минуту. Ещё пять минут ушло на тестирование. Понял что форматы PNG не кушает. Также примечания оставляет видимыми. Где заменить в коде True На False надеюсь сами догадаетесь... [vba]
Код
Sub InsertPicturesInComments()
Dim rngPics As Range, rngOut As Range Dim i As Long, p As String, w As Long, h As Long
Set rngPics = Range("B1:B1") 'диапазон путей к картинкам (путь+имя).bmp .jpg .gif Set rngOut = Range("A1:A1") 'диапазон вывода примечаний
rngOut.ClearComments 'удаляем старые примечания
'проходим в цикле по ячейкам For i = 1 To rngPics.Cells.Count
p = rngPics.Cells(i, 1).Value 'считываем путь к файлу картинки w = LoadPicture(p).Width 'и ее размеры h = LoadPicture(p).Height
With rngOut.Cells(i, 1) .AddComment.Text Text:="" 'создаем примечание без текста .Comment.Visible = True .Comment.Shape.Select True End With With rngOut.Cells(i, 1).Comment.Shape 'заливаем картинкой .Fill.UserPicture p .ScaleWidth 1, msoFalse, msoScaleFromTopLeft .ScaleHeight h / w * 1.8, msoFalse, msoScaleFromTopLeft 'корректируем размеры End With Next i End Sub
[/vba]
Код нашёл на другом форуме меньше чем за минуту. Ещё пять минут ушло на тестирование. Понял что форматы PNG не кушает. Также примечания оставляет видимыми. Где заменить в коде True На False надеюсь сами догадаетесь... [vba]
Код
Sub InsertPicturesInComments()
Dim rngPics As Range, rngOut As Range Dim i As Long, p As String, w As Long, h As Long
Set rngPics = Range("B1:B1") 'диапазон путей к картинкам (путь+имя).bmp .jpg .gif Set rngOut = Range("A1:A1") 'диапазон вывода примечаний
rngOut.ClearComments 'удаляем старые примечания
'проходим в цикле по ячейкам For i = 1 To rngPics.Cells.Count
p = rngPics.Cells(i, 1).Value 'считываем путь к файлу картинки w = LoadPicture(p).Width 'и ее размеры h = LoadPicture(p).Height
With rngOut.Cells(i, 1) .AddComment.Text Text:="" 'создаем примечание без текста .Comment.Visible = True .Comment.Shape.Select True End With With rngOut.Cells(i, 1).Comment.Shape 'заливаем картинкой .Fill.UserPicture p .ScaleWidth 1, msoFalse, msoScaleFromTopLeft .ScaleHeight h / w * 1.8, msoFalse, msoScaleFromTopLeft 'корректируем размеры End With Next i End Sub