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

Вход

Регистрация

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

 

= Мир MS Excel/Вставка рисунка из стороннего файла.. - Мир MS Excel

Старая форма входа
  • Страница 1 из 3
  • 1
  • 2
  • 3
  • »
Модератор форума: китин, _Boroda_  
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Вставка рисунка из стороннего файла.. (Макросы/Sub)
Вставка рисунка из стороннего файла..
Sashagor1982 Дата: Четверг, 11.02.2016, 22:17 | Сообщение № 1
Группа: Проверенные
Ранг: Обитатель
Сообщений: 287
Репутация: -6 ±
Замечаний: 0% ±

Excel 2007
Здравствуйте уважаемые форумчане. Подскажите пожалуйста, есть ли техническая возможность с помощью vba вставить на лист Excel рисунок из стороннего файла? Например номер пропуска это имя файла-рисунка.
Изначально

Должно получиться..

Заранее спасибо
К сообщению приложен файл: 3510842.zip (72.3 Kb)


Сообщение отредактировал Sashagor1982 - Четверг, 11.02.2016, 22:20
 
Ответить
СообщениеЗдравствуйте уважаемые форумчане. Подскажите пожалуйста, есть ли техническая возможность с помощью vba вставить на лист Excel рисунок из стороннего файла? Например номер пропуска это имя файла-рисунка.
Изначально

Должно получиться..

Заранее спасибо

Автор - Sashagor1982
Дата добавления - 11.02.2016 в 22:17
Manyasha Дата: Пятница, 12.02.2016, 12:37 | Сообщение № 2
Группа: Модераторы
Ранг: Старожил
Сообщений: 2198
Репутация: 898 ±
Замечаний: 0% ±

Excel 2010, 2016
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
[/vba]


ЯД: 410013299366744 WM: R193491431804
 
Ответить
Сообщение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
[/vba]

Автор - Manyasha
Дата добавления - 12.02.2016 в 12:37
Sashagor1982 Дата: Пятница, 12.02.2016, 15:31 | Сообщение № 3
Группа: Проверенные
Ранг: Обитатель
Сообщений: 287
Репутация: -6 ±
Замечаний: 0% ±

Excel 2007
Manyasha, Можно файл-пример скинуть, а то у меня что-то не работает)))
 
Ответить
СообщениеManyasha, Можно файл-пример скинуть, а то у меня что-то не работает)))

Автор - Sashagor1982
Дата добавления - 12.02.2016 в 15:31
Manyasha Дата: Пятница, 12.02.2016, 16:22 | Сообщение № 4
Группа: Модераторы
Ранг: Старожил
Сообщений: 2198
Репутация: 898 ±
Замечаний: 0% ±

Excel 2010, 2016
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]
Если не заработает, без файла больше править код не буду.


ЯД: 410013299366744 WM: R193491431804
 
Ответить
Сообщение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
Дата добавления - 12.02.2016 в 16:22
Sashagor1982 Дата: Пятница, 12.02.2016, 17:06 | Сообщение № 5
Группа: Проверенные
Ранг: Обитатель
Сообщений: 287
Репутация: -6 ±
Замечаний: 0% ±

Excel 2007
Дело в том что, подпрограмма должна запускаться из другого максора т.к. значение в скобках имеется. Но фаил исходный сейчас в первом сообщении приложен архив.
[moder]
Цитата
приложен архив
Там только картинка. Файла нет.[/moder]


Сообщение отредактировал Manyasha - Пятница, 12.02.2016, 17:12
 
Ответить
СообщениеДело в том что, подпрограмма должна запускаться из другого максора т.к. значение в скобках имеется. Но фаил исходный сейчас в первом сообщении приложен архив.
[moder]
Цитата
приложен архив
Там только картинка. Файла нет.[/moder]

Автор - Sashagor1982
Дата добавления - 12.02.2016 в 17:06
Manyasha Дата: Пятница, 12.02.2016, 17:16 | Сообщение № 6
Группа: Модераторы
Ранг: Старожил
Сообщений: 2198
Репутация: 898 ±
Замечаний: 0% ±

Excel 2010, 2016
подпрограмма должна запускаться из другого максора
а вот и нет.
Это макрос, обрабатывающий событие листа Change (изменение).
Помещать его нужно не в обычный модуль, а в модуль листа: пкм по ярлычку листа - исходный текст.

UPD
Добавила файл. Положите его в папку вместе с картинкой
К сообщению приложен файл: primer.xlsm (16.3 Kb)


ЯД: 410013299366744 WM: R193491431804

Сообщение отредактировал Manyasha - Пятница, 12.02.2016, 17:20
 
Ответить
Сообщение
подпрограмма должна запускаться из другого максора
а вот и нет.
Это макрос, обрабатывающий событие листа Change (изменение).
Помещать его нужно не в обычный модуль, а в модуль листа: пкм по ярлычку листа - исходный текст.

UPD
Добавила файл. Положите его в папку вместе с картинкой

Автор - Manyasha
Дата добавления - 12.02.2016 в 17:16
Sashagor1982 Дата: Пятница, 12.02.2016, 17:41 | Сообщение № 7
Группа: Проверенные
Ранг: Обитатель
Сообщений: 287
Репутация: -6 ±
Замечаний: 0% ±

Excel 2007
Manyasha, а как его изменить, что бы работал из модуля?
[moder]
без файла больше править код не буду
[/moder]


Сообщение отредактировал Manyasha - Пятница, 12.02.2016, 17:44
 
Ответить
СообщениеManyasha, а как его изменить, что бы работал из модуля?
[moder]
без файла больше править код не буду
[/moder]

Автор - Sashagor1982
Дата добавления - 12.02.2016 в 17:41
Sashagor1982 Дата: Пятница, 12.02.2016, 20:01 | Сообщение № 8
Группа: Проверенные
Ранг: Обитатель
Сообщений: 287
Репутация: -6 ±
Замечаний: 0% ±

Excel 2007
Как можно изменить код, что бы работал из модуля? И если не сложно, можно как-нибудь изменить, то если такого файла-картинки нет, то ошибку не выдавало, а просто не вставляла картинку..
К сообщению приложен файл: -090714.xls (33.5 Kb)


Сообщение отредактировал Sashagor1982 - Пятница, 12.02.2016, 20:05
 
Ответить
СообщениеКак можно изменить код, что бы работал из модуля? И если не сложно, можно как-нибудь изменить, то если такого файла-картинки нет, то ошибку не выдавало, а просто не вставляла картинку..

Автор - Sashagor1982
Дата добавления - 12.02.2016 в 20:01
Udik Дата: Пятница, 12.02.2016, 21:00 | Сообщение № 9
Группа: Друзья
Ранг: Старожил
Сообщений: 1588
Репутация: 192 ±
Замечаний: 0% ±

Excel 2016 х 64
Ну если надо чтоб в стандартном модуле код был, то немного измените код 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]
К сообщению приложен файл: insJPG.xlsb (29.5 Kb)


вот вам барабан
яд 41001231307558 wm R419131876897
udik1968@gmail.com
 
Ответить
СообщениеНу если надо чтоб в стандартном модуле код был, то немного измените код 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]

Автор - Udik
Дата добавления - 12.02.2016 в 21:00
Sashagor1982 Дата: Пятница, 12.02.2016, 21:48 | Сообщение № 10
Группа: Проверенные
Ранг: Обитатель
Сообщений: 287
Репутация: -6 ±
Замечаний: 0% ±

Excel 2007
Спасибо тем кто помогал. Задача выполнена..
 
Ответить
СообщениеСпасибо тем кто помогал. Задача выполнена..

Автор - Sashagor1982
Дата добавления - 12.02.2016 в 21:48
Sashagor1982 Дата: Воскресенье, 14.02.2016, 14:21 | Сообщение № 11
Группа: Проверенные
Ранг: Обитатель
Сообщений: 287
Репутация: -6 ±
Замечаний: 0% ±

Excel 2007
В процессе применении данной программы выявилась следующая проблемма. Как можно изменить данный код если рисунок надо вставлять в книгу создаваемую в процессе выполнения программы. Т.е книга и лист на который вставляется фото создается и в процессе работы не бывает активным.
 
Ответить
СообщениеВ процессе применении данной программы выявилась следующая проблемма. Как можно изменить данный код если рисунок надо вставлять в книгу создаваемую в процессе выполнения программы. Т.е книга и лист на который вставляется фото создается и в процессе работы не бывает активным.

Автор - Sashagor1982
Дата добавления - 14.02.2016 в 14:21
RAN Дата: Воскресенье, 14.02.2016, 14:40 | Сообщение № 12
Группа: Друзья
Ранг: Экселист
Сообщений: 5660
Репутация: 1163 ±
Замечаний: 0% ±

2010
Т.е книга и лист на который вставляется фото создается и в процессе работы не бывает активным.

Не бывает так, как вы написали, а вновь созданная книга всегда становится активной.


Быть или не быть, вот в чем загвоздка!
 
Ответить
Сообщение
Т.е книга и лист на который вставляется фото создается и в процессе работы не бывает активным.

Не бывает так, как вы написали, а вновь созданная книга всегда становится активной.

Автор - RAN
Дата добавления - 14.02.2016 в 14:40
Sashagor1982 Дата: Воскресенье, 14.02.2016, 15:42 | Сообщение № 13
Группа: Проверенные
Ранг: Обитатель
Сообщений: 287
Репутация: -6 ±
Замечаний: 0% ±

Excel 2007
Да верно, но фото вставляется во второй лист, который не будет активным. Про книгу я написал т.к. событием листа не воспользоваться.


Сообщение отредактировал Sashagor1982 - Воскресенье, 14.02.2016, 15:43
 
Ответить
СообщениеДа верно, но фото вставляется во второй лист, который не будет активным. Про книгу я написал т.к. событием листа не воспользоваться.

Автор - Sashagor1982
Дата добавления - 14.02.2016 в 15:42
StoTisteg Дата: Воскресенье, 14.02.2016, 16:30 | Сообщение № 14
Группа: Авторы
Ранг: Старожил
Сообщений: 1161
Репутация: 103 ±
Замечаний: 0% ±

Excel 2010
фото вставляется во второй лист

Вставляется, но не должно или должно, но не вставляется? Первого быть не может, во вновь созданной книге всегда активен первый лист, а для второго замените в коде ActiveSheet на Worksheets(2).


Интуитивно понятный код - это когда интуитивно понятно, что это код.
 
Ответить
Сообщение
фото вставляется во второй лист

Вставляется, но не должно или должно, но не вставляется? Первого быть не может, во вновь созданной книге всегда активен первый лист, а для второго замените в коде ActiveSheet на Worksheets(2).

Автор - StoTisteg
Дата добавления - 14.02.2016 в 16:30
RAN Дата: Воскресенье, 14.02.2016, 16:38 | Сообщение № 15
Группа: Друзья
Ранг: Экселист
Сообщений: 5660
Репутация: 1163 ±
Замечаний: 0% ±

2010
Про книгу я написал т.к. событием листа не воспользоваться.

Ща все брошу, и картишки раскину, чем вы воспользоваться желаете. yes


Быть или не быть, вот в чем загвоздка!
 
Ответить
Сообщение
Про книгу я написал т.к. событием листа не воспользоваться.

Ща все брошу, и картишки раскину, чем вы воспользоваться желаете. yes

Автор - RAN
Дата добавления - 14.02.2016 в 16:38
Sashagor1982 Дата: Воскресенье, 14.02.2016, 17:11 | Сообщение № 16
Группа: Проверенные
Ранг: Обитатель
Сообщений: 287
Репутация: -6 ±
Замечаний: 0% ±

Excel 2007
Имею ввиду, что файл с макросом никаких изменений не претерпевает, примеры которые вызываются изменением листа работать не будут, как изменить код что бы он работал с изменением листа?
 
Ответить
СообщениеИмею ввиду, что файл с макросом никаких изменений не претерпевает, примеры которые вызываются изменением листа работать не будут, как изменить код что бы он работал с изменением листа?

Автор - Sashagor1982
Дата добавления - 14.02.2016 в 17:11
Sashagor1982 Дата: Воскресенье, 14.02.2016, 17:39 | Сообщение № 17
Группа: Проверенные
Ранг: Обитатель
Сообщений: 287
Репутация: -6 ±
Замечаний: 0% ±

Excel 2007
[vba]
Код
Call insJPG (Target)
[/vba]
Что необходимо передать в качестве Target если вызывается не из листа?
 
Ответить
Сообщение[vba]
Код
Call insJPG (Target)
[/vba]
Что необходимо передать в качестве Target если вызывается не из листа?

Автор - Sashagor1982
Дата добавления - 14.02.2016 в 17:39
RAN Дата: Воскресенье, 14.02.2016, 17:53 | Сообщение № 18
Группа: Друзья
Ранг: Экселист
Сообщений: 5660
Репутация: 1163 ±
Замечаний: 0% ±

2010
[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 - Воскресенье, 14.02.2016, 17:55
 
Ответить
Сообщение[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
Дата добавления - 14.02.2016 в 17:53
Sashagor1982 Дата: Воскресенье, 14.02.2016, 18:16 | Сообщение № 19
Группа: Проверенные
Ранг: Обитатель
Сообщений: 287
Репутация: -6 ±
Замечаний: 0% ±

Excel 2007
Спасибо, но как вызвать данный код?
[vba]
Код
Call insJPG(Target)
[/vba]
Чему равно Target?
 
Ответить
СообщениеСпасибо, но как вызвать данный код?
[vba]
Код
Call insJPG(Target)
[/vba]
Чему равно Target?

Автор - Sashagor1982
Дата добавления - 14.02.2016 в 18:16
RAN Дата: Воскресенье, 14.02.2016, 18:29 | Сообщение № 20
Группа: Друзья
Ранг: Экселист
Сообщений: 5660
Репутация: 1163 ±
Замечаний: 0% ±

2010
а это в лист

[vba]
Код
Private Sub Worksheet_Change(ByVal Target As Range)
Call insJPG(Target)
End Sub
[/vba]

не из листа?

Молчат картишки.


Быть или не быть, вот в чем загвоздка!

Сообщение отредактировал RAN - Воскресенье, 14.02.2016, 18:30
 
Ответить
Сообщение
а это в лист

[vba]
Код
Private Sub Worksheet_Change(ByVal Target As Range)
Call insJPG(Target)
End Sub
[/vba]

не из листа?

Молчат картишки.

Автор - RAN
Дата добавления - 14.02.2016 в 18:29
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Вставка рисунка из стороннего файла.. (Макросы/Sub)
  • Страница 1 из 3
  • 1
  • 2
  • 3
  • »
Поиск:

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