вставка картинки

Дата: Вторник, 18.07.2017, 16:16 | Сообщение № 1

Группа: Проверенные

Ранг: Обитатель

Сообщений: 268

Репутация: 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]

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

Дата: Вторник, 18.07.2017, 16:32 | Сообщение № 2

Группа: Модераторы

Ранг: Местный житель

Сообщений: 16674

Репутация: 6479 ±

Замечаний: 0% ±

2003; 2007; 2010; 2013 RUS

Цитата ZamoK, 18.07.2017 в 16:16, в сообщении № 1 ()

есть макрос

Этот? 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

Дата: Среда, 19.07.2017, 11:15 | Сообщение № 3

Группа: Проверенные

Ранг: Обитатель

Сообщений: 268

Репутация: 4 ±

Замечаний: 0% ±

Excel 2003-2016

_Boroda_, Да этот

. Спасибо большое.

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

Дата: Среда, 19.07.2017, 11:24 | Сообщение № 4

Группа: Проверенные

Ранг: Обитатель

Сообщений: 268

Репутация: 4 ±

Замечаний: 0% ±

Excel 2003-2016

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

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

Дата: Среда, 19.07.2017, 11:40 | Сообщение № 5

Группа: Модераторы

Ранг: Местный житель

Сообщений: 16674

Репутация: 6479 ±

Замечаний: 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]

Дата: Среда, 19.07.2017, 11:45 | Сообщение № 6

Группа: Проверенные

Ранг: Обитатель

Сообщений: 268

Репутация: 4 ±

Замечаний: 0% ±

Excel 2003-2016

Ругается ошибка 1004
[vba]

Код

With ActiveSheet.Pictures.Insert("D:\адрес\" & Selection(1).Offset(, 1))

[/vba]

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

Сообщение отредактировал ZamoK - Среда, 19.07.2017, 12:23

Дата: Среда, 19.07.2017, 11:53 | Сообщение № 7

Группа: Модераторы

Ранг: Местный житель

Сообщений: 16674

Репутация: 6479 ±

Замечаний: 0% ±

2003; 2007; 2010; 2013 RUS

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

Дата: Среда, 19.07.2017, 12:16 | Сообщение № 8

Группа: Проверенные

Ранг: Обитатель

Сообщений: 268

Репутация: 4 ±

Замечаний: 0% ±

Excel 2003-2016

Цитата _Boroda_, 19.07.2017 в 11:53, в сообщении № 7 ()

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

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

Цитата ZamoK, 18.07.2017 в 16:16, в сообщении № 1 ()

в ячейке слева от активной

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

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

Дата: Среда, 19.07.2017, 12:21 | Сообщение № 9

Группа: Проверенные

Ранг: Обитатель

Сообщений: 268

Репутация: 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

Roman777

Дата: Среда, 19.07.2017, 16:18 | Сообщение № 10

Группа: Проверенные

Ранг: Ветеран

Сообщений: 980

Репутация: 127 ±

Замечаний: 0% ±

Excel 2007, Excel 2013

ZamoK, Не подскажите, а что означает выражение:
[vba]

Код

If "D:\адрес\" & Selection(1).Offset(, -1) & ".jpg" > 0 Then

[/vba], ато честно признаться, я что-то не понимаю что это такое...

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

Дата: Четверг, 20.07.2017, 08:54 | Сообщение № 11

Группа: Проверенные

Ранг: Обитатель

Сообщений: 268

Репутация: 4 ±

Замечаний: 0% ±

Excel 2003-2016

Roman777, спасибо за внимательность, и в правду работает не корректно. Это проверка на наличие файла, поменял строку так [vba]

Код

If Not "D:\адрес\" & Selection(1).Offset(, -1) & ".jpg" = Null Then

[/vba] теперь работает хорошо.

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

Roman777

Дата: Четверг, 20.07.2017, 09:05 | Сообщение № 12

Группа: Проверенные

Ранг: Ветеран

Сообщений: 980

Репутация: 127 ±

Замечаний: 0% ±

Excel 2007, Excel 2013

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

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

Сообщение отредактировал Roman777 - Четверг, 20.07.2017, 09:06

Дата: Четверг, 20.07.2017, 09:30 | Сообщение № 13

Группа: Модераторы

Ранг: Местный житель

Сообщений: 16674

Репутация: 6479 ±

Замечаний: 0% ±

2003; 2007; 2010; 2013 RUS

Цитата Roman777, 20.07.2017 в 09:05, в сообщении № 12 ()

Проверка на наличие файла делается

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