Добрый день! есть макрос который вставляет картинку в активную ячейку. Как можно доработать этот макрос, чтоб он брал картинку из конкретной папки на диске Д а имя файла в ячейке слева от активной [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]
Добрый день! есть макрос который вставляет картинку в активную ячейку. Как можно доработать этот макрос, чтоб он брал картинку из конкретной папки на диске Д а имя файла в ячейке слева от активной [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
Так нужно? Точки - это Ваш путь. Кладет картинку в ячейку В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
Так нужно? Точки - это Ваш путь. Кладет картинку в ячейку В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
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]
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
Хорошенько проверьте правильность пути к папке и правильность названия файла в ячейке справа от выделенной на момент запуска макроса (не забудьте, что оно должно быть с расширением Если все нормально - кладите файл-пример сюда
Хорошенько проверьте правильность пути к папке и правильность названия файла в ячейке справа от выделенной на момент запуска макроса (не забудьте, что оно должно быть с расширением Если все нормально - кладите файл-пример сюда_Boroda_
Немного допилил (бывают картинки разные) получилось так: [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]
Немного допилил (бывают картинки разные) получилось так: [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
ZamoK, Добрый день! у меня подозрения, что опять что-то нето, ибо: "D:\адрес\" &(либо строка, либо "") & ".jpg" - всегда останется не null. У Вас это выражение всегда будет истиной. Проверка на наличие файла делается ф-ей Dir.
ZamoK, Добрый день! у меня подозрения, что опять что-то нето, ибо: "D:\адрес\" &(либо строка, либо "") & ".jpg" - всегда останется не null. У Вас это выражение всегда будет истиной. Проверка на наличие файла делается ф-ей Dir.Roman777
Много чего не знаю!!!!
Сообщение отредактировал Roman777 - Четверг, 20.07.2017, 09:06