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

Вход

Регистрация

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

 

= Мир MS Excel/вставка картинки в ячейку программно - Мир MS Excel

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

Excel 2010
Здравствуйте,

Есть два столбца: id, рисунок
имя картинки состоит из id. Например, id=111, а рисунок 111.jpg.
Я установила высоту строк в свойствах=200.

Дело в том, что картинка вставится в выделенную ячейку. Как сделать, чтобы картинка была в В2?

Было бы вообще замечательно, если подскажите,как сделать так, чтобы циклом вставлялись картинки? ID будут в А1-А10,а рисунки их соответсвенно в В1-В10. Макрос или процедура неважно.
[vba]
Код

Public Sub insPic()

   Application.ScreenUpdating = False

Dim BookID As String, T As String, myDir As String

myDir = "C:\Users\user\Pictures\"
ID = Range("A1")
T = ".jpg"

ActiveSheet.Shapes.AddPicture Filename:=myDir & ID & T, linktofile:=msoFalse, savewithdocument:=msoTrue, Left:=ActiveCell.Left, Top:=ActiveCell.Top, Width:=200, Height:=200

Application.ScreenUpdating = True
[/vba]
К сообщению приложен файл: 2367893.xlsx(46Kb)
 
Ответить
СообщениеЗдравствуйте,

Есть два столбца: id, рисунок
имя картинки состоит из id. Например, id=111, а рисунок 111.jpg.
Я установила высоту строк в свойствах=200.

Дело в том, что картинка вставится в выделенную ячейку. Как сделать, чтобы картинка была в В2?

Было бы вообще замечательно, если подскажите,как сделать так, чтобы циклом вставлялись картинки? ID будут в А1-А10,а рисунки их соответсвенно в В1-В10. Макрос или процедура неважно.
[vba]
Код

Public Sub insPic()

   Application.ScreenUpdating = False

Dim BookID As String, T As String, myDir As String

myDir = "C:\Users\user\Pictures\"
ID = Range("A1")
T = ".jpg"

ActiveSheet.Shapes.AddPicture Filename:=myDir & ID & T, linktofile:=msoFalse, savewithdocument:=msoTrue, Left:=ActiveCell.Left, Top:=ActiveCell.Top, Width:=200, Height:=200

Application.ScreenUpdating = True
[/vba]

Автор - Aumi
Дата добавления - 07.10.2017 в 19:34
Roman777 Дата: Воскресенье, 08.10.2017, 09:29 | Сообщение № 2
Группа: Проверенные
Ранг: Ветеран
Сообщений: 806
Репутация: 90 ±
Замечаний: 0% ±

Excel 2007, Excel 2013
Добрый день!
Попробуйте такой
[vba]
Код
Public Sub insPic()
Application.ScreenUpdating = False
Dim BookID As String, T As String, myDir As String
Dim i_n&
i_n = ActiveSheet.cells(rows.count,1).end(xlUp).row
myDir = "C:\Users\user\Pictures\"
T = ".jpg"
for i = 1 to i_n
   ID = cells(i,1)
   ActiveSheet.Shapes.AddPicture Filename:=myDir & ID & T, linktofile:=msoFalse, savewithdocument:=msoTrue, Left:=ActiveCell.Left, Top:=ActiveCell.Top, Width:=200, Height:=200
next i
Application.ScreenUpdating = True
End sub
[/vba]


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

Сообщение отредактировал Roman777 - Воскресенье, 08.10.2017, 09:30
 
Ответить
СообщениеДобрый день!
Попробуйте такой
[vba]
Код
Public Sub insPic()
Application.ScreenUpdating = False
Dim BookID As String, T As String, myDir As String
Dim i_n&
i_n = ActiveSheet.cells(rows.count,1).end(xlUp).row
myDir = "C:\Users\user\Pictures\"
T = ".jpg"
for i = 1 to i_n
   ID = cells(i,1)
   ActiveSheet.Shapes.AddPicture Filename:=myDir & ID & T, linktofile:=msoFalse, savewithdocument:=msoTrue, Left:=ActiveCell.Left, Top:=ActiveCell.Top, Width:=200, Height:=200
next i
Application.ScreenUpdating = True
End sub
[/vba]

Автор - Roman777
Дата добавления - 08.10.2017 в 09:29
Aumi Дата: Понедельник, 09.10.2017, 09:58 | Сообщение № 3
Группа: Пользователи
Ранг: Новичок
Сообщений: 11
Репутация: 0 ±
Замечаний: 0% ±

Excel 2010
Ответ не работает. Ниже вариант работает. Только вот помогите пожалуйста превратить в функцию. Очень нужно
[vba]
Код
Public Sub Test2()
Application.ScreenUpdating = False
Dim iPath$, iCell As Range
iPath = "C:\Users\malysheva.n\Downloads\"
For Each iCell In [A1:A2]
ActiveSheet.Shapes.AddPicture iPath & iCell & ".jpg", _
False, True, iCell(1, 3).Left, iCell(1, 3).Top, iCell(1, 3).Width, iCell(1, 3).Height
Next
Application.ScreenUpdating = True
End Sub
[/vba]
Не понимаю, но почему то код вечно в одну строчку. а пользуюсь code ]

Вот функция, то у нее Ошибка-неправильная ссылка на ячейку

[vba]
Код
Public Function Pic1(c)
With Application.Caller
ActiveSheet.Shapes.AddPicture _
"C:\Users\User\Pictures\" & c & ".jpg", _
False, True, .Left, .Top, .Width, .Height
End With
End Function
[/vba]


Сообщение отредактировал Aumi - Понедельник, 09.10.2017, 10:09
 
Ответить
СообщениеОтвет не работает. Ниже вариант работает. Только вот помогите пожалуйста превратить в функцию. Очень нужно
[vba]
Код
Public Sub Test2()
Application.ScreenUpdating = False
Dim iPath$, iCell As Range
iPath = "C:\Users\malysheva.n\Downloads\"
For Each iCell In [A1:A2]
ActiveSheet.Shapes.AddPicture iPath & iCell & ".jpg", _
False, True, iCell(1, 3).Left, iCell(1, 3).Top, iCell(1, 3).Width, iCell(1, 3).Height
Next
Application.ScreenUpdating = True
End Sub
[/vba]
Не понимаю, но почему то код вечно в одну строчку. а пользуюсь code ]

Вот функция, то у нее Ошибка-неправильная ссылка на ячейку

[vba]
Код
Public Function Pic1(c)
With Application.Caller
ActiveSheet.Shapes.AddPicture _
"C:\Users\User\Pictures\" & c & ".jpg", _
False, True, .Left, .Top, .Width, .Height
End With
End Function
[/vba]

Автор - Aumi
Дата добавления - 09.10.2017 в 09:58
Aumi Дата: Понедельник, 09.10.2017, 10:44 | Сообщение № 4
Группа: Пользователи
Ранг: Новичок
Сообщений: 11
Репутация: 0 ±
Замечаний: 0% ±

Excel 2010
Есть такой код, но не получается тянуть формулу вниз.
Каждый раз приходится прописывать формулу в В1 и В2

[vba]
Код
Public Function Pic(c) As Range
     ActiveSheet.Shapes.AddPicture "C:\Users\User\Pictures\" & c & ".jpg", _
    False, True, c(1, 2).Left, c(1, 2).Top, c(1, 2).Width, c(1, 2).Height
End Function
[/vba]
 
Ответить
СообщениеЕсть такой код, но не получается тянуть формулу вниз.
Каждый раз приходится прописывать формулу в В1 и В2

[vba]
Код
Public Function Pic(c) As Range
     ActiveSheet.Shapes.AddPicture "C:\Users\User\Pictures\" & c & ".jpg", _
    False, True, c(1, 2).Left, c(1, 2).Top, c(1, 2).Width, c(1, 2).Height
End Function
[/vba]

Автор - Aumi
Дата добавления - 09.10.2017 в 10:44
sboy Дата: Понедельник, 09.10.2017, 11:10 | Сообщение № 5
Группа: Проверенные
Ранг: Старожил
Сообщений: 1174
Репутация: 294 ±
Замечаний: 0% ±

Excel 2010
Aumi, если с - это столбец А, то формулу пишите в С (не в В!), тогда будет протягиваться
 
Ответить
СообщениеAumi, если с - это столбец А, то формулу пишите в С (не в В!), тогда будет протягиваться

Автор - sboy
Дата добавления - 09.10.2017 в 11:10
Aumi Дата: Понедельник, 09.10.2017, 11:11 | Сообщение № 6
Группа: Пользователи
Ранг: Новичок
Сообщений: 11
Репутация: 0 ±
Замечаний: 0% ±

Excel 2010
sboy, Работает спасибо!
 
Ответить
Сообщениеsboy, Работает спасибо!

Автор - Aumi
Дата добавления - 09.10.2017 в 11:11
Aumi Дата: Понедельник, 09.10.2017, 11:59 | Сообщение № 7
Группа: Пользователи
Ранг: Новичок
Сообщений: 11
Репутация: 0 ±
Замечаний: 0% ±

Excel 2010
Еще есть просьба. Не думаю, что надо новую тему начинать.
Возникла такая проблема. Имя картинки может состоять из 7 или 8 символов. Часть имени содержит имя папки, в которой она лежит.
Например, 1234567.jpg лежит в папке 123
12345678.jpg лежит в папке 1234
Имя картинки лежит в столбце в А в виде 1234567 -первая запись, и таких много

как получить часть записи, так еще 7 знаков или 8.
Пишет -ошибка в значении. Возможно, имя папки не получает

[vba]
Код
Public Function Pic(c As Range)
Dim mylen, papka
mylen = Len(c)
If mylen < 8 Then
papka = Right(c, mylen - 3)
ElseIf mylen = 8 Then papka = Right(c, mylen - 4)
End If

     ActiveSheet.Shapes.AddPicture "C:\Users\user\Pictures\" & papka & "\" & c & ".jpg", _
    False, True, c(1, 2).Left, c(1, 2).Top, c(1, 2).Width, c(1, 2).Height
End Function
[/vba]


Сообщение отредактировал Aumi - Понедельник, 09.10.2017, 11:59
 
Ответить
СообщениеЕще есть просьба. Не думаю, что надо новую тему начинать.
Возникла такая проблема. Имя картинки может состоять из 7 или 8 символов. Часть имени содержит имя папки, в которой она лежит.
Например, 1234567.jpg лежит в папке 123
12345678.jpg лежит в папке 1234
Имя картинки лежит в столбце в А в виде 1234567 -первая запись, и таких много

как получить часть записи, так еще 7 знаков или 8.
Пишет -ошибка в значении. Возможно, имя папки не получает

[vba]
Код
Public Function Pic(c As Range)
Dim mylen, papka
mylen = Len(c)
If mylen < 8 Then
papka = Right(c, mylen - 3)
ElseIf mylen = 8 Then papka = Right(c, mylen - 4)
End If

     ActiveSheet.Shapes.AddPicture "C:\Users\user\Pictures\" & papka & "\" & c & ".jpg", _
    False, True, c(1, 2).Left, c(1, 2).Top, c(1, 2).Width, c(1, 2).Height
End Function
[/vba]

Автор - Aumi
Дата добавления - 09.10.2017 в 11:59
_Boroda_ Дата: Понедельник, 09.10.2017, 12:10 | Сообщение № 8
Группа: Модераторы
Ранг: Местный житель
Сообщений: 11852
Репутация: 4911 ±
Замечаний: 0% ±

2003; 2007; 2010; 2013 RUS
Не совсем ясно про что Вы.
Может, так?
[vba]
Код
" & Right(c,4) & ".jpg",
[/vba]

Вернее, вот так
[vba]
Код
ActiveSheet.Shapes.AddPicture "C:\Users\user\Pictures\" & left(c, len(c)-4) & "\" & Right(c, 4) & ".jpg", _
[/vba]


Скажи мне, кудесник, любимец ба’гов...
Платная помощь:
Boroda_Excel@mail.ru
Яндекс-деньги: 41001632713405 | Webmoney: R289877159277; Z102172301748; E177867141995
 
Ответить
СообщениеНе совсем ясно про что Вы.
Может, так?
[vba]
Код
" & Right(c,4) & ".jpg",
[/vba]

Вернее, вот так
[vba]
Код
ActiveSheet.Shapes.AddPicture "C:\Users\user\Pictures\" & left(c, len(c)-4) & "\" & Right(c, 4) & ".jpg", _
[/vba]

Автор - _Boroda_
Дата добавления - 09.10.2017 в 12:10
sboy Дата: Понедельник, 09.10.2017, 12:13 | Сообщение № 9
Группа: Проверенные
Ранг: Старожил
Сообщений: 1174
Репутация: 294 ±
Замечаний: 0% ±

Excel 2010
Например, 1234567.jpg лежит в папке 123

а у вас papka получается 4567
 
Ответить
Сообщение
Например, 1234567.jpg лежит в папке 123

а у вас papka получается 4567

Автор - sboy
Дата добавления - 09.10.2017 в 12:13
Aumi Дата: Понедельник, 09.10.2017, 12:25 | Сообщение № 10
Группа: Пользователи
Ранг: Новичок
Сообщений: 11
Репутация: 0 ±
Замечаний: 0% ±

Excel 2010
sboy, _Boroda_, Короче путь моей картинки 1234567 будет таким:C:\Users\user\Pictures\123\1234567.jpg

[vba]
Код
Public Function Pic(c As Range)

     ActiveSheet.Shapes.AddPicture "C:\Users\malysheva.n\Downloads\" & Left(c, Len(c) - 4) & "\" & c & ".jpg", _
    False, True, c(1, 2).Left, c(1, 2).Top, c(1, 2).Width, c(1, 2).Height
End Function
[/vba]

Проблема решилась) Спасибо
 
Ответить
Сообщениеsboy, _Boroda_, Короче путь моей картинки 1234567 будет таким:C:\Users\user\Pictures\123\1234567.jpg

[vba]
Код
Public Function Pic(c As Range)

     ActiveSheet.Shapes.AddPicture "C:\Users\malysheva.n\Downloads\" & Left(c, Len(c) - 4) & "\" & c & ".jpg", _
    False, True, c(1, 2).Left, c(1, 2).Top, c(1, 2).Width, c(1, 2).Height
End Function
[/vba]

Проблема решилась) Спасибо

Автор - Aumi
Дата добавления - 09.10.2017 в 12:25
Aumi Дата: Понедельник, 09.10.2017, 12:43 | Сообщение № 11
Группа: Пользователи
Ранг: Новичок
Сообщений: 11
Репутация: 0 ±
Замечаний: 0% ±

Excel 2010
sboy, а как сделать, чтобы формулу пишешь в любом столбце и там же картинка? Ну чтоб картинка была не в В, а D допустим, и в D формулу пишем
 
Ответить
Сообщениеsboy, а как сделать, чтобы формулу пишешь в любом столбце и там же картинка? Ну чтоб картинка была не в В, а D допустим, и в D формулу пишем

Автор - Aumi
Дата добавления - 09.10.2017 в 12:43
sboy Дата: Понедельник, 09.10.2017, 13:20 | Сообщение № 12
Группа: Проверенные
Ранг: Старожил
Сообщений: 1174
Репутация: 294 ±
Замечаний: 0% ±

Excel 2010
Aumi, пишем формулу в любой столбец с закреплением
Код
=Pic($A1)

копируем, выделяем необходимый диапазон нужного столбца и вставляем
 
Ответить
СообщениеAumi, пишем формулу в любой столбец с закреплением
Код
=Pic($A1)

копируем, выделяем необходимый диапазон нужного столбца и вставляем

Автор - sboy
Дата добавления - 09.10.2017 в 13:20
Aumi Дата: Понедельник, 09.10.2017, 13:51 | Сообщение № 13
Группа: Пользователи
Ранг: Новичок
Сообщений: 11
Репутация: 0 ±
Замечаний: 0% ±

Excel 2010
sboy, знач! стало писаться в диапозоне нужного столбца. Может в коде что нибудь поменять?
Вместо этого, где явно указывается в каком столбце результат
[vba]
Код
c(1, 2).Left, c(1, 2).Top, c(1, 2).Width, c(1, 2).Height
[/vba]

Пыталась исправить на
[vba]
Код
Public Function Pic1(c As Range)

     ActiveSheet.Shapes.AddPicture "C:\Users\user\Pictures\" & Left(c, Len(c) - 4) & "\" & c & ".jpg", _
    False, True, ActiveCell.Left, ActiveCell.Top, ActiveCell.Width, ActiveCell.Height
End Function
[/vba]
Но получается так, что после растягивания формулы вниз первая картинка вставляется во все ячейки, а все остальные в первую кучей


Сообщение отредактировал Aumi - Понедельник, 09.10.2017, 14:16
 
Ответить
Сообщениеsboy, знач! стало писаться в диапозоне нужного столбца. Может в коде что нибудь поменять?
Вместо этого, где явно указывается в каком столбце результат
[vba]
Код
c(1, 2).Left, c(1, 2).Top, c(1, 2).Width, c(1, 2).Height
[/vba]

Пыталась исправить на
[vba]
Код
Public Function Pic1(c As Range)

     ActiveSheet.Shapes.AddPicture "C:\Users\user\Pictures\" & Left(c, Len(c) - 4) & "\" & c & ".jpg", _
    False, True, ActiveCell.Left, ActiveCell.Top, ActiveCell.Width, ActiveCell.Height
End Function
[/vba]
Но получается так, что после растягивания формулы вниз первая картинка вставляется во все ячейки, а все остальные в первую кучей

Автор - Aumi
Дата добавления - 09.10.2017 в 13:51
sboy Дата: Понедельник, 09.10.2017, 14:31 | Сообщение № 14
Группа: Проверенные
Ранг: Старожил
Сообщений: 1174
Репутация: 294 ±
Замечаний: 0% ±

Excel 2010
Попробуйте через offset
[vba]
Код
c.Offset(0, 1).Left, c.Offset(0, 1).Top, c.Offset(0, 1).Width, c.Offset(0, 1).Height
[/vba]
 
Ответить
СообщениеПопробуйте через offset
[vba]
Код
c.Offset(0, 1).Left, c.Offset(0, 1).Top, c.Offset(0, 1).Width, c.Offset(0, 1).Height
[/vba]

Автор - sboy
Дата добавления - 09.10.2017 в 14:31
Aumi Дата: Понедельник, 09.10.2017, 14:39 | Сообщение № 15
Группа: Пользователи
Ранг: Новичок
Сообщений: 11
Репутация: 0 ±
Замечаний: 0% ±

Excel 2010
sboy, Рисунок вставляется во 2 столбец, а формулу писала в 18
также пробовала
[vba]
Код
ActiveCell.Offset(0, -1).Left, ActiveCell.Offset(0, -1).Top, ActiveCell.Offset(0, -1).Width, ActiveCell.Offset(0, -1).Height
[/vba]

Но тогда куча всех картинок находились в 1 строке слева от формулы. То что вся куча слева понятно, все остальное нет


Сообщение отредактировал Aumi - Понедельник, 09.10.2017, 14:47
 
Ответить
Сообщениеsboy, Рисунок вставляется во 2 столбец, а формулу писала в 18
также пробовала
[vba]
Код
ActiveCell.Offset(0, -1).Left, ActiveCell.Offset(0, -1).Top, ActiveCell.Offset(0, -1).Width, ActiveCell.Offset(0, -1).Height
[/vba]

Но тогда куча всех картинок находились в 1 строке слева от формулы. То что вся куча слева понятно, все остальное нет

Автор - Aumi
Дата добавления - 09.10.2017 в 14:39
sboy Дата: Понедельник, 09.10.2017, 14:45 | Сообщение № 16
Группа: Проверенные
Ранг: Старожил
Сообщений: 1174
Репутация: 294 ±
Замечаний: 0% ±

Excel 2010
Aumi, он вставляется на offset(0-строк, +1 столбец) от ссылки, которую передаем функции. В Вашем случае ссылка в A1, картинка будет в В1.
 
Ответить
СообщениеAumi, он вставляется на offset(0-строк, +1 столбец) от ссылки, которую передаем функции. В Вашем случае ссылка в A1, картинка будет в В1.

Автор - sboy
Дата добавления - 09.10.2017 в 14:45
Aumi Дата: Понедельник, 09.10.2017, 15:01 | Сообщение № 17
Группа: Пользователи
Ранг: Новичок
Сообщений: 11
Репутация: 0 ±
Замечаний: 0% ±

Excel 2010
sboy, все равно знач!
Притом я хочу, чтоб картинка была там же, где и формула, а не справа от А1.
Просто если я скопирую этот код для другого документа, то там картинка нужна будет другом столбце. и чтобы каждый раз не лезть в код, картинка вставлялась в столбец с формулой или хотя бы слева от написания формулы

P.S. спасибо, что не бросает меня одну с этой проблемой
 
Ответить
Сообщениеsboy, все равно знач!
Притом я хочу, чтоб картинка была там же, где и формула, а не справа от А1.
Просто если я скопирую этот код для другого документа, то там картинка нужна будет другом столбце. и чтобы каждый раз не лезть в код, картинка вставлялась в столбец с формулой или хотя бы слева от написания формулы

P.S. спасибо, что не бросает меня одну с этой проблемой

Автор - Aumi
Дата добавления - 09.10.2017 в 15:01
sboy Дата: Понедельник, 09.10.2017, 15:02 | Сообщение № 18
Группа: Проверенные
Ранг: Старожил
Сообщений: 1174
Репутация: 294 ±
Замечаний: 0% ±

Excel 2010
Как вариант, передать функции, столбец, куда вставлять картинку
[vba]
Код
Public Function Pic(c As Range, stolb As Range)
    Set kuda = Cells(c.Row, stolb.Column)
    'picpath = "D:\Мои документы\Изображения\" & c & ".jpg"
    picpath = "C:\Users\user\Pictures\" & Left(c, Len(c) - 4) & "\" & c & ".jpg"
        With ActiveSheet.Shapes.AddPicture(picpath, 0, -1, 0, 0, 0, 0)
            .Left = kuda.Left
            .Top = kuda.Top
            .Width = kuda.Width
            .Height = kuda.Height
        End With
End Function
[/vba]
формула будет иметь вид
Код
=Pic(A1;M1)

в А1 имя файла с картинкой, в М1 сама картинка


Сообщение отредактировал sboy - Понедельник, 09.10.2017, 15:05
 
Ответить
СообщениеКак вариант, передать функции, столбец, куда вставлять картинку
[vba]
Код
Public Function Pic(c As Range, stolb As Range)
    Set kuda = Cells(c.Row, stolb.Column)
    'picpath = "D:\Мои документы\Изображения\" & c & ".jpg"
    picpath = "C:\Users\user\Pictures\" & Left(c, Len(c) - 4) & "\" & c & ".jpg"
        With ActiveSheet.Shapes.AddPicture(picpath, 0, -1, 0, 0, 0, 0)
            .Left = kuda.Left
            .Top = kuda.Top
            .Width = kuda.Width
            .Height = kuda.Height
        End With
End Function
[/vba]
формула будет иметь вид
Код
=Pic(A1;M1)

в А1 имя файла с картинкой, в М1 сама картинка

Автор - sboy
Дата добавления - 09.10.2017 в 15:02
Aumi Дата: Понедельник, 09.10.2017, 16:24 | Сообщение № 19
Группа: Пользователи
Ранг: Новичок
Сообщений: 11
Репутация: 0 ±
Замечаний: 0% ±

Excel 2010
sboy, спасибо!все супер!
 
Ответить
Сообщениеsboy, спасибо!все супер!

Автор - Aumi
Дата добавления - 09.10.2017 в 16:24
Мир MS Excel » Вопросы и решения » Вопросы по VBA » вставка картинки в ячейку программно (Макросы/Sub)
Страница 1 из 11
Поиск:

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