Есть два столбца: 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"
Есть два столбца: 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"
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]
Добрый день! Попробуйте такой [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]
Код
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]
Ответ не работает. Ниже вариант работает. Только вот помогите пожалуйста превратить в функцию. Очень нужно [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
Есть такой код, но не получается тянуть формулу вниз. Каждый раз приходится прописывать формулу в В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
Еще есть просьба. Не думаю, что надо новую тему начинать. Возникла такая проблема. Имя картинки может состоять из 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]
Еще есть просьба. Не думаю, что надо новую тему начинать. Возникла такая проблема. Имя картинки может состоять из 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
sboy, знач! стало писаться в диапозоне нужного столбца. Может в коде что нибудь поменять? Вместо этого, где явно указывается в каком столбце результат [vba]
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] Но получается так, что после растягивания формулы вниз первая картинка вставляется во все ячейки, а все остальные в первую кучей
sboy, знач! стало писаться в диапозоне нужного столбца. Может в коде что нибудь поменять? Вместо этого, где явно указывается в каком столбце результат [vba]
sboy, все равно знач! Притом я хочу, чтоб картинка была там же, где и формула, а не справа от А1. Просто если я скопирую этот код для другого документа, то там картинка нужна будет другом столбце. и чтобы каждый раз не лезть в код, картинка вставлялась в столбец с формулой или хотя бы слева от написания формулы
P.S. спасибо, что не бросает меня одну с этой проблемой
sboy, все равно знач! Притом я хочу, чтоб картинка была там же, где и формула, а не справа от А1. Просто если я скопирую этот код для другого документа, то там картинка нужна будет другом столбце. и чтобы каждый раз не лезть в код, картинка вставлялась в столбец с формулой или хотя бы слева от написания формулы
P.S. спасибо, что не бросает меня одну с этой проблемойAumi
Как вариант, передать функции, столбец, куда вставлять картинку [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 сама картинка
Как вариант, передать функции, столбец, куда вставлять картинку [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
Яндекс: 410016850021169
Сообщение отредактировал sboy - Понедельник, 09.10.2017, 15:05