Здравствуйте уважаемые форумчане. Подскажите пожалуйста, есть ли техническая возможность с помощью vba вставить на лист Excel рисунок из стороннего файла? Например номер пропуска это имя файла-рисунка. Изначально Должно получиться.. Заранее спасибо
Здравствуйте уважаемые форумчане. Подскажите пожалуйста, есть ли техническая возможность с помощью vba вставить на лист Excel рисунок из стороннего файла? Например номер пропуска это имя файла-рисунка. Изначально Должно получиться.. Заранее спасибоSashagor1982
Private Sub Worksheet_Change(ByVal Target As Range) If Target.Count > 1 Then Exit Sub If Not Intersect(Target, Range("b2")) Is Nothing And Target.Value <> "" Then picPath = ThisWorkbook.Path & "\" & Target.Value & ".jpg" Set pic = ActiveSheet.Pictures.Insert(picPath) With pic .Left = 0: .Top = 0 .Width = Range("a1:a7").Width .Height = Range("a1:a7").Height End With End If End Sub
[/vba]
Sashagor1982, так? [vba]
Код
Private Sub Worksheet_Change(ByVal Target As Range) If Target.Count > 1 Then Exit Sub If Not Intersect(Target, Range("b2")) Is Nothing And Target.Value <> "" Then picPath = ThisWorkbook.Path & "\" & Target.Value & ".jpg" Set pic = ActiveSheet.Pictures.Insert(picPath) With pic .Left = 0: .Top = 0 .Width = Range("a1:a7").Width .Height = Range("a1:a7").Height End With End If End Sub
Sashagor1982, в Вашем вложении в 1-м сообщении нет файла. Вы предлагаете мне Ваши таблицы самой нарисовать? Макрос я проверяла на пустом листе, забыла про объединенные ячейки. проверяйте так: [vba]
Код
Private Sub Worksheet_Change(ByVal Target As Range) If Not Intersect(Target, Range("b2")) Is Nothing And [b2].Value <> "" Then picPath = ThisWorkbook.Path & "\" & [b2].Value & ".jpg" Set pic = ActiveSheet.Pictures.Insert(picPath) With pic .Left = 0: .Top = 0 .Width = Range("a1:a7").Width .Height = Range("a1:a7").Height End With End If End Sub
[/vba] Если не заработает, без файла больше править код не буду.
Sashagor1982, в Вашем вложении в 1-м сообщении нет файла. Вы предлагаете мне Ваши таблицы самой нарисовать? Макрос я проверяла на пустом листе, забыла про объединенные ячейки. проверяйте так: [vba]
Код
Private Sub Worksheet_Change(ByVal Target As Range) If Not Intersect(Target, Range("b2")) Is Nothing And [b2].Value <> "" Then picPath = ThisWorkbook.Path & "\" & [b2].Value & ".jpg" Set pic = ActiveSheet.Pictures.Insert(picPath) With pic .Left = 0: .Top = 0 .Width = Range("a1:a7").Width .Height = Range("a1:a7").Height End With End If End Sub
[/vba] Если не заработает, без файла больше править код не буду.Manyasha
Дело в том что, подпрограмма должна запускаться из другого максора т.к. значение в скобках имеется. Но фаил исходный сейчас в первом сообщении приложен архив. [moder]
Цитата
приложен архив
Там только картинка. Файла нет.[/moder]
Дело в том что, подпрограмма должна запускаться из другого максора т.к. значение в скобках имеется. Но фаил исходный сейчас в первом сообщении приложен архив. [moder]
Цитата
приложен архив
Там только картинка. Файла нет.[/moder]Sashagor1982
Сообщение отредактировал Manyasha - Пятница, 12.02.2016, 17:12
подпрограмма должна запускаться из другого максора
а вот и нет. Это макрос, обрабатывающий событие листа Change (изменение). Помещать его нужно не в обычный модуль, а в модуль листа: пкм по ярлычку листа - исходный текст.
UPD Добавила файл. Положите его в папку вместе с картинкой
подпрограмма должна запускаться из другого максора
а вот и нет. Это макрос, обрабатывающий событие листа Change (изменение). Помещать его нужно не в обычный модуль, а в модуль листа: пкм по ярлычку листа - исходный текст.
UPD Добавила файл. Положите его в папку вместе с картинкойManyasha
Как можно изменить код, что бы работал из модуля? И если не сложно, можно как-нибудь изменить, то если такого файла-картинки нет, то ошибку не выдавало, а просто не вставляла картинку..
Как можно изменить код, что бы работал из модуля? И если не сложно, можно как-нибудь изменить, то если такого файла-картинки нет, то ошибку не выдавало, а просто не вставляла картинку..Sashagor1982
Ну если надо чтоб в стандартном модуле код был, то немного измените код Manyasha, в модуль [vba]
Код
Public Sub insJPG(ByVal Target As Range) If Not Intersect(Target, Range("b2")) Is Nothing Then On Error Resume Next picPath = ThisWorkbook.Path & "\" & Target.Value & ".jpg" Set pic = ActiveSheet.Pictures.Insert(picPath) With pic .Left = 0: .Top = 0 .Height = ActiveSheet.Range("a1:a7").Height .Width = ActiveSheet.Range("a1:a7").Width End With End If End Sub
[/vba]
а это в лист [vba]
Код
Private Sub Worksheet_Change(ByVal Target As Range) Call insJPG(Target) End Sub
[/vba]
Ну если надо чтоб в стандартном модуле код был, то немного измените код Manyasha, в модуль [vba]
Код
Public Sub insJPG(ByVal Target As Range) If Not Intersect(Target, Range("b2")) Is Nothing Then On Error Resume Next picPath = ThisWorkbook.Path & "\" & Target.Value & ".jpg" Set pic = ActiveSheet.Pictures.Insert(picPath) With pic .Left = 0: .Top = 0 .Height = ActiveSheet.Range("a1:a7").Height .Width = ActiveSheet.Range("a1:a7").Width End With End If End Sub
[/vba]
а это в лист [vba]
Код
Private Sub Worksheet_Change(ByVal Target As Range) Call insJPG(Target) End Sub
В процессе применении данной программы выявилась следующая проблемма. Как можно изменить данный код если рисунок надо вставлять в книгу создаваемую в процессе выполнения программы. Т.е книга и лист на который вставляется фото создается и в процессе работы не бывает активным.
В процессе применении данной программы выявилась следующая проблемма. Как можно изменить данный код если рисунок надо вставлять в книгу создаваемую в процессе выполнения программы. Т.е книга и лист на который вставляется фото создается и в процессе работы не бывает активным.Sashagor1982
Вставляется, но не должно или должно, но не вставляется? Первого быть не может, во вновь созданной книге всегда активен первый лист, а для второго замените в коде ActiveSheet на Worksheets(2).
Вставляется, но не должно или должно, но не вставляется? Первого быть не может, во вновь созданной книге всегда активен первый лист, а для второго замените в коде ActiveSheet на Worksheets(2).StoTisteg
Интуитивно понятный код - это когда интуитивно понятно, что это код.
Имею ввиду, что файл с макросом никаких изменений не претерпевает, примеры которые вызываются изменением листа работать не будут, как изменить код что бы он работал с изменением листа?
Имею ввиду, что файл с макросом никаких изменений не претерпевает, примеры которые вызываются изменением листа работать не будут, как изменить код что бы он работал с изменением листа?Sashagor1982
Public Sub insJPG(ByVal Target As Range) Dim pic As Shape, cell As Range
If Not Intersect(Target, Range("b2")) Is Nothing Then On Error Resume Next picPath = ThisWorkbook.Path & "\" & Target.Value & ".jpg" Set cell = ActiveWorkbook.Sheets(2).Range("A1:A7") Set pic = cell.Worksheet.Shapes.AddPicture(picPath, False, True, cell.Left - 1, cell.Top - 1, cell.Width - 2, cell.Height - 2) End If End Sub
[/vba]
PS новую книгу создавайте самостоятельно. Данный код вставит картинку на лист2 активной книги.
[vba]
Код
Public Sub insJPG(ByVal Target As Range) Dim pic As Shape, cell As Range
If Not Intersect(Target, Range("b2")) Is Nothing Then On Error Resume Next picPath = ThisWorkbook.Path & "\" & Target.Value & ".jpg" Set cell = ActiveWorkbook.Sheets(2).Range("A1:A7") Set pic = cell.Worksheet.Shapes.AddPicture(picPath, False, True, cell.Left - 1, cell.Top - 1, cell.Width - 2, cell.Height - 2) End If End Sub
[/vba]
PS новую книгу создавайте самостоятельно. Данный код вставит картинку на лист2 активной книги.RAN
Быть или не быть, вот в чем загвоздка!
Сообщение отредактировал RAN - Воскресенье, 14.02.2016, 17:55