Домашняя страница Undo Do New Save Карта сайта Обратная связь Поиск по форуму
МИР MS EXCEL - Гость.xls

Вход

Регистрация

Напомнить пароль

 

= Мир MS Excel/Добавить в комментарий картинку к ячейке сводной таблицы - Мир MS Excel

Старая форма входа
  • Страница 1 из 1
  • 1
Модератор форума: китин, _Boroda_  
Добавить в комментарий картинку к ячейке сводной таблицы
Marrex Дата: Пятница, 10.07.2020, 11:14 | Сообщение № 1
Группа: Пользователи
Ранг: Прохожий
Сообщений: 7
Репутация: 0 ±
Замечаний: 0% ±

Excel 2019
Всем привет!
Есть сводная таблица, получающая данные при открытии из внешней базы MS SQL.
Полученный набор данных содержит информацию о товаре (характеристики, фин. показатели и пр.), среди которых есть ссылка на фото продукции.
Задача вывести фото в примечание одной из ячеек на этапе загрузки данных из внешнего источника (как в вложении). Что бы для пользователя это было прозрачно.
Буду признателен за помощь!
К сообщению приложен файл: 3478321.jpg (25.3 Kb)
 
Ответить
СообщениеВсем привет!
Есть сводная таблица, получающая данные при открытии из внешней базы MS SQL.
Полученный набор данных содержит информацию о товаре (характеристики, фин. показатели и пр.), среди которых есть ссылка на фото продукции.
Задача вывести фото в примечание одной из ячеек на этапе загрузки данных из внешнего источника (как в вложении). Что бы для пользователя это было прозрачно.
Буду признателен за помощь!

Автор - Marrex
Дата добавления - 10.07.2020 в 11:14
fairylive Дата: Суббота, 11.07.2020, 17:31 | Сообщение № 2
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 122
Репутация: 4 ±
Замечаний: 0% ±

Excel 2016
Код нашёл на другом форуме меньше чем за минуту. Ещё пять минут ушло на тестирование. Понял что форматы 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
[/vba]

Автор - fairylive
Дата добавления - 11.07.2020 в 17:31
  • Страница 1 из 1
  • 1
Поиск:

Яндекс.Метрика Яндекс цитирования
© 2010-2024 · Дизайн: MichaelCH · Хостинг от uCoz · При использовании материалов сайта, ссылка на www.excelworld.ru обязательна!