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

Вход

Регистрация

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

 

= Мир MS Excel/Макрос вставки изображения по условию, изменения его размера - Мир MS Excel

Старая форма входа
  • Страница 1 из 1
  • 1
Модератор форума: китин, _Boroda_  
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Макрос вставки изображения по условию, изменения его размера (Макросы/Sub)
Макрос вставки изображения по условию, изменения его размера
Russel Дата: Четверг, 27.02.2020, 10:47 | Сообщение № 1
Группа: Друзья
Ранг: Старожил
Сообщений: 1394
Репутация: 320 ±
Замечаний: 0% ±

Excel 2010
Доброго дня, коллеги!

Беглый поиск не дал 100% подходящего решения, в связи с чем прошу вашей помощи!

Есть файл excel с презентацией объекта на одном листе, в который собирается информацию из разных книг - это реализовано и работает нормально.
Данные меняются на лету в зависимости от выбранного имени объекта.

Необходимо в определенной ячейке налету заменять фотографию на фото из подпапки /photo в той же папке, где и исходный файл, с именем, соответствующим имени объекта, менять размер фотографии.

Дополнительно нужен отдельный макрос, который будет сохранять лист в pdf в подпапку /out c именем, соответствующим имени объекта.
К сообщению приложен файл: 1369495.xlsm (75.5 Kb)

QIWI 9173973973
 
Ответить
СообщениеДоброго дня, коллеги!

Беглый поиск не дал 100% подходящего решения, в связи с чем прошу вашей помощи!

Есть файл excel с презентацией объекта на одном листе, в который собирается информацию из разных книг - это реализовано и работает нормально.
Данные меняются на лету в зависимости от выбранного имени объекта.

Необходимо в определенной ячейке налету заменять фотографию на фото из подпапки /photo в той же папке, где и исходный файл, с именем, соответствующим имени объекта, менять размер фотографии.

Дополнительно нужен отдельный макрос, который будет сохранять лист в pdf в подпапку /out c именем, соответствующим имени объекта.
Автор - Russel
Дата добавления - 27.02.2020 в 10:47
krosav4ig Дата: Четверг, 27.02.2020, 12:13 | Сообщение № 2
Группа: Друзья
Ранг: Старожил
Сообщений: 2347
Репутация: 997 ±
Замечаний: 0% ±

Excel 2007,2010,2013
Вариант с ActiveX image и UDF для проверки данных
[vba]
Код
Function xx() As Range
    With [Z2].Resize(9)
        .Value = [transpose(transpose(Text(Row(R1:R9),"ТО 000")))]
        Set xx = .Cells
    End With
    On Error Resume Next
    Dim sFolder: sFolder = ThisWorkbook.Path & "\Photo\"
    With Application.Caller
        .Parent.OLEObjects("Image1").Object.Picture = LoadPicture(sFolder & .Value & ".jpg")
    End With
End Function
[/vba]
К сообщению приложен файл: 4462230.xlsm (23.9 Kb)

email:krosav4ig26@gmail.com WMR R207627035142 WMZ Z821145374535 ЯД 410012026478460

Сообщение отредактировал krosav4ig - Четверг, 27.02.2020, 13:14
 
Ответить
СообщениеВариант с ActiveX image и UDF для проверки данных
[vba]
Код
Function xx() As Range
    With [Z2].Resize(9)
        .Value = [transpose(transpose(Text(Row(R1:R9),"ТО 000")))]
        Set xx = .Cells
    End With
    On Error Resume Next
    Dim sFolder: sFolder = ThisWorkbook.Path & "\Photo\"
    With Application.Caller
        .Parent.OLEObjects("Image1").Object.Picture = LoadPicture(sFolder & .Value & ".jpg")
    End With
End Function
[/vba]
Автор - krosav4ig
Дата добавления - 27.02.2020 в 12:13
Russel Дата: Четверг, 27.02.2020, 12:52 | Сообщение № 3
Группа: Друзья
Ранг: Старожил
Сообщений: 1394
Репутация: 320 ±
Замечаний: 0% ±

Excel 2010
krosav4ig, спасибо!
Есть нюанс - фотография обрезается под нужный размер, а нужно чтобы масштабировалась.

QIWI 9173973973
 
Ответить
Сообщениеkrosav4ig, спасибо!
Есть нюанс - фотография обрезается под нужный размер, а нужно чтобы масштабировалась.
Автор - Russel
Дата добавления - 27.02.2020 в 12:52
krosav4ig Дата: Четверг, 27.02.2020, 13:14 | Сообщение № 4
Группа: Друзья
Ранг: Старожил
Сообщений: 2347
Репутация: 997 ±
Замечаний: 0% ±

Excel 2007,2010,2013
да, забыл свойства контрола поменять
установил BackStyle = Transparent
BorderStyle = None
PictureAlignment = TopLeft
PictureSizimgMode = zoom

перезалил файл

email:krosav4ig26@gmail.com WMR R207627035142 WMZ Z821145374535 ЯД 410012026478460
 
Ответить
Сообщениеда, забыл свойства контрола поменять
установил BackStyle = Transparent
BorderStyle = None
PictureAlignment = TopLeft
PictureSizimgMode = zoom

перезалил файл
Автор - krosav4ig
Дата добавления - 27.02.2020 в 13:14
Russel Дата: Четверг, 27.02.2020, 15:15 | Сообщение № 5
Группа: Друзья
Ранг: Старожил
Сообщений: 1394
Репутация: 320 ±
Замечаний: 0% ±

Excel 2010
Андрей, я очень извиняюсь за беспокойство, но похоже, что фал тот же самый, по крайней мере работает также и макрос в модуле идентичный. UPD С масштабирование разобрался.
Еще вопрос: как перенести функционал в рабочий файл? Макрос скопировать и вставил в модуль рабочей книги, добавил АктивХ изображение, что еще нужно сделать чтобы все работало??

QIWI 9173973973

Сообщение отредактировал Russel - Четверг, 27.02.2020, 18:13
 
Ответить
СообщениеАндрей, я очень извиняюсь за беспокойство, но похоже, что фал тот же самый, по крайней мере работает также и макрос в модуле идентичный. UPD С масштабирование разобрался.
Еще вопрос: как перенести функционал в рабочий файл? Макрос скопировать и вставил в модуль рабочей книги, добавил АктивХ изображение, что еще нужно сделать чтобы все работало??
Автор - Russel
Дата добавления - 27.02.2020 в 15:15
krosav4ig Дата: Четверг, 27.02.2020, 19:07 | Сообщение № 6
Группа: Друзья
Ранг: Старожил
Сообщений: 2347
Репутация: 997 ±
Замечаний: 0% ±

Excel 2007,2010,2013
на ленте Разработчик->Режим конструктора
ПКМ по activex контролу -> Свойства
установить необходимые свойства, убедиться что имя контрола в свойствах совпадает с именем, прописанном в макросе, добавить имя в диспетчер имен и использовать его в проверке данных


UPD.
Если объект невидим, то его можно выделить через Alt+F10
К сообщению приложен файл: 2946716.png (127.0 Kb)

email:krosav4ig26@gmail.com WMR R207627035142 WMZ Z821145374535 ЯД 410012026478460

Сообщение отредактировал krosav4ig - Четверг, 27.02.2020, 19:38
 
Ответить
Сообщениена ленте Разработчик->Режим конструктора
ПКМ по activex контролу -> Свойства
установить необходимые свойства, убедиться что имя контрола в свойствах совпадает с именем, прописанном в макросе, добавить имя в диспетчер имен и использовать его в проверке данных


UPD.
Если объект невидим, то его можно выделить через Alt+F10
Автор - krosav4ig
Дата добавления - 27.02.2020 в 19:07
Santtic Дата: Четверг, 27.02.2020, 22:03 | Сообщение № 7
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 190
Репутация: 1 ±
Замечаний: 0% ±

Excel 2016
Цитата krosav4ig, 27.02.2020 в 12:13, в сообщении № 2 ()
Вариант с ActiveX image и UDF для проверки данных

Скажите пожалуйста, у вас он тоже медленно работает.
У меня есть файл, правда на менее изображений в разы. Там через диспетчер имен все реализовано. То быстрее работает. Или это зависит от размера изображения?
 
Ответить
Сообщение
Цитата krosav4ig, 27.02.2020 в 12:13, в сообщении № 2 ()
Вариант с ActiveX image и UDF для проверки данных

Скажите пожалуйста, у вас он тоже медленно работает.
У меня есть файл, правда на менее изображений в разы. Там через диспетчер имен все реализовано. То быстрее работает. Или это зависит от размера изображения?
Автор - Santtic
Дата добавления - 27.02.2020 в 22:03
Russel Дата: Четверг, 27.02.2020, 22:42 | Сообщение № 8
Группа: Друзья
Ранг: Старожил
Сообщений: 1394
Репутация: 320 ±
Замечаний: 0% ±

Excel 2010
krosav4ig, спасибо!
Теперь все как доктор прописал!

Макрос сохранения в ПДФ нашел на параллельном сайте:
[vba]
Код

Sub сохранить()
Dim Fname As String
Fname = "C:\PDFs\" & Sheets("Лист1").Range("B2").Value
        ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=Fname, _
        IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
End Sub
[/vba]

QIWI 9173973973
 
Ответить
Сообщениеkrosav4ig, спасибо!
Теперь все как доктор прописал!

Макрос сохранения в ПДФ нашел на параллельном сайте:
[vba]
Код

Sub сохранить()
Dim Fname As String
Fname = "C:\PDFs\" & Sheets("Лист1").Range("B2").Value
        ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=Fname, _
        IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
End Sub
[/vba]
Автор - Russel
Дата добавления - 27.02.2020 в 22:42
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Макрос вставки изображения по условию, изменения его размера (Макросы/Sub)
  • Страница 1 из 1
  • 1
Поиск:

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