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

Вход

Регистрация

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

 

= Мир MS Excel/вставка картинки - Мир MS Excel

Регистрация · Логин: · Пароль: · · Забыли пароль?
Страница 1 из 11
Модератор форума: _Boroda_, Pelena, Manyasha, SLAVICK 
Мир MS Excel » Вопросы и решения » Вопросы по VBA » вставка картинки (Макросы/Sub)
вставка картинки
ZamoK Дата: Вторник, 18.07.2017, 16:16 | Сообщение № 1
Группа: Проверенные
Ранг: Обитатель
Сообщений: 257
Репутация: 4 ±
Замечаний: 0% ±

Excel 2003-2016
Добрый день!
есть макрос который вставляет картинку в активную ячейку. Как можно доработать этот макрос, чтоб он брал картинку из конкретной папки на диске Д а имя файла в ячейке слева от активной
[vba]
Код
Sub ВставкаКартинки() 'вставка картинки
Application.Dialogs(xlDialogInsertPicture).Show
With Selection
    k = .Height / .Width
    .Width = Cells(1, 2).Width * 1 ' привязал ширину картинки к ширине 1 ячеек
    .Height = Cells(2, 2).Height ' высота - сохраняет соотношения сторон картинки
    .Top = .Top ' устанавливаю координату по Y
    .Left = .Left ' устанавливаю координату по X
End With
End Sub
[/vba]


Я не Гуру, но стремлюсь!
 
Ответить
СообщениеДобрый день!
есть макрос который вставляет картинку в активную ячейку. Как можно доработать этот макрос, чтоб он брал картинку из конкретной папки на диске Д а имя файла в ячейке слева от активной
[vba]
Код
Sub ВставкаКартинки() 'вставка картинки
Application.Dialogs(xlDialogInsertPicture).Show
With Selection
    k = .Height / .Width
    .Width = Cells(1, 2).Width * 1 ' привязал ширину картинки к ширине 1 ячеек
    .Height = Cells(2, 2).Height ' высота - сохраняет соотношения сторон картинки
    .Top = .Top ' устанавливаю координату по Y
    .Left = .Left ' устанавливаю координату по X
End With
End Sub
[/vba]

Автор - ZamoK
Дата добавления - 18.07.2017 в 16:16
_Boroda_ Дата: Вторник, 18.07.2017, 16:32 | Сообщение № 2
Группа: Модераторы
Ранг: Местный житель
Сообщений: 10992
Репутация: 4564 ±
Замечаний: 0% ±

2003; 2007; 2010; 2013 RUS
есть макрос
Этот? http://www.excelworld.ru/forum/10-24330-188914-16-1465459981

Так нужно? Точки - это Ваш путь. Кладет картинку в ячейку В1
[vba]
Код
Sub ВставкаКартинки() 'вставка картинки
    Dim d As Range
    Set d = Cells(1, 2)
     With ActiveSheet.Pictures.Insert("D:\.........\" & Selection(1).Offset(, 1))
        .Width = d.Width ' привязал ширину картинки к ширине 1 ячеек
        .Height = d.Height ' высота - сохраняет соотношения сторон картинки
        .Top = d.Top ' устанавливаю координату по Y
        .Left = d.Left ' устанавливаю координату по X
    End With
End Sub
[/vba]
==
Переписал немного


Скажи мне, кудесник, любимец ба’гов...
Платная помощь:
Boroda_Excel@mail.ru
Яндекс-деньги: 41001632713405 | Webmoney: R289877159277; Z102172301748; E177867141995
 
Ответить
Сообщение
есть макрос
Этот? http://www.excelworld.ru/forum/10-24330-188914-16-1465459981

Так нужно? Точки - это Ваш путь. Кладет картинку в ячейку В1
[vba]
Код
Sub ВставкаКартинки() 'вставка картинки
    Dim d As Range
    Set d = Cells(1, 2)
     With ActiveSheet.Pictures.Insert("D:\.........\" & Selection(1).Offset(, 1))
        .Width = d.Width ' привязал ширину картинки к ширине 1 ячеек
        .Height = d.Height ' высота - сохраняет соотношения сторон картинки
        .Top = d.Top ' устанавливаю координату по Y
        .Left = d.Left ' устанавливаю координату по X
    End With
End Sub
[/vba]
==
Переписал немного

Автор - _Boroda_
Дата добавления - 18.07.2017 в 16:32
ZamoK Дата: Среда, 19.07.2017, 11:15 | Сообщение № 3
Группа: Проверенные
Ранг: Обитатель
Сообщений: 257
Репутация: 4 ±
Замечаний: 0% ±

Excel 2003-2016
_Boroda_, Да этот :D . Спасибо большое.


Я не Гуру, но стремлюсь!
 
Ответить
Сообщение_Boroda_, Да этот :D . Спасибо большое.

Автор - ZamoK
Дата добавления - 19.07.2017 в 11:15
ZamoK Дата: Среда, 19.07.2017, 11:24 | Сообщение № 4
Группа: Проверенные
Ранг: Обитатель
Сообщений: 257
Репутация: 4 ±
Замечаний: 0% ±

Excel 2003-2016
Не немного не так. К исходнику надо всего лишь конкретный путь указать, вставлять нужно именно в активную ячейку (не в В2).


Я не Гуру, но стремлюсь!
 
Ответить
СообщениеНе немного не так. К исходнику надо всего лишь конкретный путь указать, вставлять нужно именно в активную ячейку (не в В2).

Автор - ZamoK
Дата добавления - 19.07.2017 в 11:24
_Boroda_ Дата: Среда, 19.07.2017, 11:40 | Сообщение № 5
Группа: Модераторы
Ранг: Местный житель
Сообщений: 10992
Репутация: 4564 ±
Замечаний: 0% ±

2003; 2007; 2010; 2013 RUS
ZamoK, у меня такое ощущение, что под этим логином зашел совсем другой человек. Это действительно Вы?
===
Конкретный путь Вы прописываете в макросе на месте вот этого "D:\.........\"
Чтобы вставлять в активную ячейку, нужно заменить
[vba]
Код
Set d = Cells(1, 2)
[/vba]
на
[vba]
Код
Set d = selection(1)
[/vba]

[vba]
Код
Sub ВставкаКартинки() 'вставка картинки
    Dim d As Range
    Set d = Selection(1)
    With ActiveSheet.Pictures.Insert("D:\.........\" & d.Offset(, 1))
        .Width = d.Width ' привязал ширину картинки к ширине 1 ячеек
        .Height = d.Height ' высота - сохраняет соотношения сторон картинки
        .Top = d.Top ' устанавливаю координату по Y
        .Left = d.Left ' устанавливаю координату по X
    End With
End Sub
[/vba]


Скажи мне, кудесник, любимец ба’гов...
Платная помощь:
Boroda_Excel@mail.ru
Яндекс-деньги: 41001632713405 | Webmoney: R289877159277; Z102172301748; E177867141995
 
Ответить
СообщениеZamoK, у меня такое ощущение, что под этим логином зашел совсем другой человек. Это действительно Вы?
===
Конкретный путь Вы прописываете в макросе на месте вот этого "D:\.........\"
Чтобы вставлять в активную ячейку, нужно заменить
[vba]
Код
Set d = Cells(1, 2)
[/vba]
на
[vba]
Код
Set d = selection(1)
[/vba]

[vba]
Код
Sub ВставкаКартинки() 'вставка картинки
    Dim d As Range
    Set d = Selection(1)
    With ActiveSheet.Pictures.Insert("D:\.........\" & d.Offset(, 1))
        .Width = d.Width ' привязал ширину картинки к ширине 1 ячеек
        .Height = d.Height ' высота - сохраняет соотношения сторон картинки
        .Top = d.Top ' устанавливаю координату по Y
        .Left = d.Left ' устанавливаю координату по X
    End With
End Sub
[/vba]

Автор - _Boroda_
Дата добавления - 19.07.2017 в 11:40
ZamoK Дата: Среда, 19.07.2017, 11:45 | Сообщение № 6
Группа: Проверенные
Ранг: Обитатель
Сообщений: 257
Репутация: 4 ±
Замечаний: 0% ±

Excel 2003-2016
Ругается ошибка 1004
[vba]
Код
With ActiveSheet.Pictures.Insert("D:\адрес\" & Selection(1).Offset(, 1))
[/vba]


Я не Гуру, но стремлюсь!

Сообщение отредактировал ZamoK - Среда, 19.07.2017, 12:23
 
Ответить
СообщениеРугается ошибка 1004
[vba]
Код
With ActiveSheet.Pictures.Insert("D:\адрес\" & Selection(1).Offset(, 1))
[/vba]

Автор - ZamoK
Дата добавления - 19.07.2017 в 11:45
_Boroda_ Дата: Среда, 19.07.2017, 11:53 | Сообщение № 7
Группа: Модераторы
Ранг: Местный житель
Сообщений: 10992
Репутация: 4564 ±
Замечаний: 0% ±

2003; 2007; 2010; 2013 RUS
Хорошенько проверьте правильность пути к папке и правильность названия файла в ячейке справа от выделенной на момент запуска макроса (не забудьте, что оно должно быть с расширением
Если все нормально - кладите файл-пример сюда


Скажи мне, кудесник, любимец ба’гов...
Платная помощь:
Boroda_Excel@mail.ru
Яндекс-деньги: 41001632713405 | Webmoney: R289877159277; Z102172301748; E177867141995
 
Ответить
СообщениеХорошенько проверьте правильность пути к папке и правильность названия файла в ячейке справа от выделенной на момент запуска макроса (не забудьте, что оно должно быть с расширением
Если все нормально - кладите файл-пример сюда

Автор - _Boroda_
Дата добавления - 19.07.2017 в 11:53
ZamoK Дата: Среда, 19.07.2017, 12:16 | Сообщение № 8
Группа: Проверенные
Ранг: Обитатель
Сообщений: 257
Репутация: 4 ±
Замечаний: 0% ±

Excel 2003-2016
оно должно быть с расширением

Точно !!! Этот момент я упустил ну и поправил оффсет т.к.
в ячейке слева от активной

Все работает, все отлично.
Благодарю.


Я не Гуру, но стремлюсь!
 
Ответить
Сообщение
оно должно быть с расширением

Точно !!! Этот момент я упустил ну и поправил оффсет т.к.
в ячейке слева от активной

Все работает, все отлично.
Благодарю.

Автор - ZamoK
Дата добавления - 19.07.2017 в 12:16
ZamoK Дата: Среда, 19.07.2017, 12:21 | Сообщение № 9
Группа: Проверенные
Ранг: Обитатель
Сообщений: 257
Репутация: 4 ±
Замечаний: 0% ±

Excel 2003-2016
Немного допилил (бывают картинки разные) получилось так:
[vba]
Код
Sub ВставкаКартинки() 'вставка картинки
  If "D:\адрес\" & Selection(1).Offset(, -1) & ".jpg" > 0 Then
     j = "D:\адрес\" & Selection(1).Offset(, -1) & ".jpg"
   Else
     j = "D:\адрес\" & Selection(1).Offset(, -1) & ".tif"
  End If
    Dim d As Range
    Set d = Selection(1)
    With ActiveSheet.Pictures.Insert(j)
        .Width = d.Width ' привязал ширину картинки к ширине 1 ячеек
        .Height = d.Height ' высота - сохраняет соотношения сторон картинки
        .Top = d.Top ' устанавливаю координату по Y
        .Left = d.Left ' устанавливаю координату по X
    End With
End Sub
[/vba]


Я не Гуру, но стремлюсь!

Сообщение отредактировал ZamoK - Среда, 19.07.2017, 12:23
 
Ответить
СообщениеНемного допилил (бывают картинки разные) получилось так:
[vba]
Код
Sub ВставкаКартинки() 'вставка картинки
  If "D:\адрес\" & Selection(1).Offset(, -1) & ".jpg" > 0 Then
     j = "D:\адрес\" & Selection(1).Offset(, -1) & ".jpg"
   Else
     j = "D:\адрес\" & Selection(1).Offset(, -1) & ".tif"
  End If
    Dim d As Range
    Set d = Selection(1)
    With ActiveSheet.Pictures.Insert(j)
        .Width = d.Width ' привязал ширину картинки к ширине 1 ячеек
        .Height = d.Height ' высота - сохраняет соотношения сторон картинки
        .Top = d.Top ' устанавливаю координату по Y
        .Left = d.Left ' устанавливаю координату по X
    End With
End Sub
[/vba]

Автор - ZamoK
Дата добавления - 19.07.2017 в 12:21
Roman777 Дата: Среда, 19.07.2017, 16:18 | Сообщение № 10
Группа: Проверенные
Ранг: Ветеран
Сообщений: 780
Репутация: 88 ±
Замечаний: 0% ±

Excel 2007, Excel 2013
ZamoK, Не подскажите, а что означает выражение:
[vba]
Код
If "D:\адрес\" & Selection(1).Offset(, -1) & ".jpg" > 0 Then
[/vba], ато честно признаться, я что-то не понимаю что это такое...


Много чего не знаю!!!!
 
Ответить
СообщениеZamoK, Не подскажите, а что означает выражение:
[vba]
Код
If "D:\адрес\" & Selection(1).Offset(, -1) & ".jpg" > 0 Then
[/vba], ато честно признаться, я что-то не понимаю что это такое...

Автор - Roman777
Дата добавления - 19.07.2017 в 16:18
ZamoK Дата: Четверг, 20.07.2017, 08:54 | Сообщение № 11
Группа: Проверенные
Ранг: Обитатель
Сообщений: 257
Репутация: 4 ±
Замечаний: 0% ±

Excel 2003-2016
Roman777, спасибо за внимательность, и в правду работает не корректно. Это проверка на наличие файла, поменял строку так [vba]
Код
If Not "D:\адрес\" & Selection(1).Offset(, -1) & ".jpg" = Null Then
[/vba] теперь работает хорошо.


Я не Гуру, но стремлюсь!
 
Ответить
СообщениеRoman777, спасибо за внимательность, и в правду работает не корректно. Это проверка на наличие файла, поменял строку так [vba]
Код
If Not "D:\адрес\" & Selection(1).Offset(, -1) & ".jpg" = Null Then
[/vba] теперь работает хорошо.

Автор - ZamoK
Дата добавления - 20.07.2017 в 08:54
Roman777 Дата: Четверг, 20.07.2017, 09:05 | Сообщение № 12
Группа: Проверенные
Ранг: Ветеран
Сообщений: 780
Репутация: 88 ±
Замечаний: 0% ±

Excel 2007, Excel 2013
ZamoK, Добрый день! у меня подозрения, что опять что-то нето, ибо:
"D:\адрес\" &(либо строка, либо "") & ".jpg" - всегда останется не null. У Вас это выражение всегда будет истиной. Проверка на наличие файла делается ф-ей Dir.


Много чего не знаю!!!!

Сообщение отредактировал Roman777 - Четверг, 20.07.2017, 09:06
 
Ответить
СообщениеZamoK, Добрый день! у меня подозрения, что опять что-то нето, ибо:
"D:\адрес\" &(либо строка, либо "") & ".jpg" - всегда останется не null. У Вас это выражение всегда будет истиной. Проверка на наличие файла делается ф-ей Dir.

Автор - Roman777
Дата добавления - 20.07.2017 в 09:05
_Boroda_ Дата: Четверг, 20.07.2017, 09:30 | Сообщение № 13
Группа: Модераторы
Ранг: Местный житель
Сообщений: 10992
Репутация: 4564 ±
Замечаний: 0% ±

2003; 2007; 2010; 2013 RUS
Проверка на наличие файла делается

в другой теме
Эта закрыта


Скажи мне, кудесник, любимец ба’гов...
Платная помощь:
Boroda_Excel@mail.ru
Яндекс-деньги: 41001632713405 | Webmoney: R289877159277; Z102172301748; E177867141995
 
Ответить
Сообщение
Проверка на наличие файла делается

в другой теме
Эта закрыта

Автор - _Boroda_
Дата добавления - 20.07.2017 в 09:30
Мир MS Excel » Вопросы и решения » Вопросы по VBA » вставка картинки (Макросы/Sub)
Страница 1 из 11
Поиск:

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