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

Вход

Регистрация

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

 

= Мир MS Excel/Динамическое изменение изображения в ячейке - Мир MS Excel

Старая форма входа
  • Страница 1 из 1
  • 1
Модератор форума: китин, _Boroda_  
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Динамическое изменение изображения в ячейке (Макросы/Sub)
Динамическое изменение изображения в ячейке
pa_mfc1186 Дата: Суббота, 03.01.2015, 12:27 | Сообщение № 1
Группа: Пользователи
Ранг: Прохожий
Сообщений: 1
Репутация: 0 ±
Замечаний: 0% ±

Добрый день

Возникла задача программно заменить существующее изображение в ячейке
Само изображение является объектом Shape.
Вариант 1.
Удаление изображения и на его место вставка нового с теми же параметрами выравнивания и т.п. Вопросов нет.
Но хотелось бы
Вариант 2.
Замена картинки в существующий shape.
Через интерфейс Excel это просто "Изменить рисунок..".
Запись макроса ничего не дает.
Изучение свойств создаваемого shape не дало наводки..
Что за код соответствует "Изменить рисунок.."

[vba]
Код

Dim r_labirint as range
Dim shp

     set r_labitint = Range("A1:J10")
     With r_labirint.Cells(1, 1)
         On Error Resume Next
         Set shp = .Worksheet.Shapes.AddPicture(ActiveWorkbook.Path + "\wall.png", False, True, .Left, .Top, .Width, .Height)
         shp.Name = "Wall" + Str(1)
     End With
      
     ' Далее необходимо в объекте shp заменить картинку на ActiveWorkbook.Path + "\wall2.png"
[/vba]
 
Ответить
СообщениеДобрый день

Возникла задача программно заменить существующее изображение в ячейке
Само изображение является объектом Shape.
Вариант 1.
Удаление изображения и на его место вставка нового с теми же параметрами выравнивания и т.п. Вопросов нет.
Но хотелось бы
Вариант 2.
Замена картинки в существующий shape.
Через интерфейс Excel это просто "Изменить рисунок..".
Запись макроса ничего не дает.
Изучение свойств создаваемого shape не дало наводки..
Что за код соответствует "Изменить рисунок.."

[vba]
Код

Dim r_labirint as range
Dim shp

     set r_labitint = Range("A1:J10")
     With r_labirint.Cells(1, 1)
         On Error Resume Next
         Set shp = .Worksheet.Shapes.AddPicture(ActiveWorkbook.Path + "\wall.png", False, True, .Left, .Top, .Width, .Height)
         shp.Name = "Wall" + Str(1)
     End With
      
     ' Далее необходимо в объекте shp заменить картинку на ActiveWorkbook.Path + "\wall2.png"
[/vba]
Автор - pa_mfc1186
Дата добавления - 03.01.2015 в 12:27
excelhelprus Дата: Воскресенье, 04.01.2015, 07:55 | Сообщение № 2
Группа: Пользователи
Ранг: Участник
Сообщений: 63
Репутация: 5 ±
Замечаний: 20% ±

2015
set r_labitint = Range("A1:J10")
With r_labirint.Cells(1, 1)
в глаза бросилось
 
Ответить
Сообщениеset r_labitint = Range("A1:J10")
With r_labirint.Cells(1, 1)
в глаза бросилось
Автор - excelhelprus
Дата добавления - 04.01.2015 в 07:55
JayBhagavan Дата: Воскресенье, 04.01.2015, 08:15 | Сообщение № 3
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 188
Репутация: 27 ±
Замечаний: 0% ±

Excel 2010
pa_mfc1186, почитайте про option explicit - это поможет в будущем избежать подобных опечаток.

Языком ты или построишь жизнь,или разрушишь ее до основания.Думайте что говорите.(с)А.Хакимов
 
Ответить
Сообщениеpa_mfc1186, почитайте про option explicit - это поможет в будущем избежать подобных опечаток.
Автор - JayBhagavan
Дата добавления - 04.01.2015 в 08:15
excelhelprus Дата: Воскресенье, 04.01.2015, 08:39 | Сообщение № 4
Группа: Пользователи
Ранг: Участник
Сообщений: 63
Репутация: 5 ±
Замечаний: 20% ±

2015
покопался в свойствах shape - тоже не нашел ссылок или путей.
А зачем менять именно в shape? вы присваиваете shap`у имя, если нужно по этому имени ищете адрес ячейки с изображением и работаете уже с ячейкой - удалить, вставить.
 
Ответить
Сообщениепокопался в свойствах shape - тоже не нашел ссылок или путей.
А зачем менять именно в shape? вы присваиваете shap`у имя, если нужно по этому имени ищете адрес ячейки с изображением и работаете уже с ячейкой - удалить, вставить.
Автор - excelhelprus
Дата добавления - 04.01.2015 в 08:39
pa_mfc Дата: Воскресенье, 04.01.2015, 13:48 | Сообщение № 5
Группа: Пользователи
Ранг: Прохожий
Сообщений: 4
Репутация: 0 ±
Замечаний: 0% ±

Excel 2010
JayBhagavan, спасибо, хорошая опция. Вспомнился студенческий паскаль..

Глаза боятся что руки делают
 
Ответить
СообщениеJayBhagavan, спасибо, хорошая опция. Вспомнился студенческий паскаль..
Автор - pa_mfc
Дата добавления - 04.01.2015 в 13:48
pa_mfc Дата: Воскресенье, 04.01.2015, 14:04 | Сообщение № 6
Группа: Пользователи
Ранг: Прохожий
Сообщений: 4
Репутация: 0 ±
Замечаний: 0% ±

Excel 2010
excelhelprus, Да, имя у shape есть и удалить, вставить - это первый вариант. Но пытливый ум хочет знать: если в контекстном меню есть "Изменить рисунок...", то значит можно это сделать программно. К тому же, как я полагаю, изменить как минимум на одно действие меньше, чем удалить+вставить.

Глаза боятся что руки делают
 
Ответить
Сообщениеexcelhelprus, Да, имя у shape есть и удалить, вставить - это первый вариант. Но пытливый ум хочет знать: если в контекстном меню есть "Изменить рисунок...", то значит можно это сделать программно. К тому же, как я полагаю, изменить как минимум на одно действие меньше, чем удалить+вставить.
Автор - pa_mfc
Дата добавления - 04.01.2015 в 14:04
nilem Дата: Воскресенье, 04.01.2015, 19:05 | Сообщение № 7
Группа: Авторы
Ранг: Старожил
Сообщений: 1613
Репутация: 563 ±
Замечаний: 0% ±

Excel 2013, 2016
типа такого, наверное (проверять по F8)
[vba]
Код
Sub ertert()
With Range("A1")
      .Parent.Shapes.AddShape(msoShapeRoundedRectangle, .Left, .Top, .Width, .Height).Name = "Wall1"
      With .Parent.Shapes("Wall1")
          .Fill.UserPicture ThisWorkbook.Path & "\wall.png"
          MsgBox "wall.png"
          .Fill.UserPicture ThisWorkbook.Path & "\ACDSee Classic.png"
          MsgBox "ACDSee Classic.png"
          .Fill.UserPicture ThisWorkbook.Path & "\Ad Aware SE.png"
          MsgBox "Ad Aware SE"
      End With
End With
End Sub
[/vba]
или лучше так
[vba]
Код
Sub ertert22()
With Range("A1")
     With .Parent.Shapes.AddShape(msoShapeRoundedRectangle, .Left, .Top, .Width, .Height)
         .Name = "Wall1"
         .Fill.UserPicture ThisWorkbook.Path & "\wall.png"
         MsgBox "wall.png"
         .Fill.UserPicture ThisWorkbook.Path & "\ACDSee Classic.png"
         MsgBox "ACDSee Classic.png"
         .Fill.UserPicture ThisWorkbook.Path & "\Ad Aware SE.png"
         MsgBox "Ad Aware SE"
     End With
End With
End Sub
[/vba]

Яндекс.Деньги 4100159601573

Сообщение отредактировал nilem - Воскресенье, 04.01.2015, 19:09
 
Ответить
Сообщениетипа такого, наверное (проверять по F8)
[vba]
Код
Sub ertert()
With Range("A1")
      .Parent.Shapes.AddShape(msoShapeRoundedRectangle, .Left, .Top, .Width, .Height).Name = "Wall1"
      With .Parent.Shapes("Wall1")
          .Fill.UserPicture ThisWorkbook.Path & "\wall.png"
          MsgBox "wall.png"
          .Fill.UserPicture ThisWorkbook.Path & "\ACDSee Classic.png"
          MsgBox "ACDSee Classic.png"
          .Fill.UserPicture ThisWorkbook.Path & "\Ad Aware SE.png"
          MsgBox "Ad Aware SE"
      End With
End With
End Sub
[/vba]
или лучше так
[vba]
Код
Sub ertert22()
With Range("A1")
     With .Parent.Shapes.AddShape(msoShapeRoundedRectangle, .Left, .Top, .Width, .Height)
         .Name = "Wall1"
         .Fill.UserPicture ThisWorkbook.Path & "\wall.png"
         MsgBox "wall.png"
         .Fill.UserPicture ThisWorkbook.Path & "\ACDSee Classic.png"
         MsgBox "ACDSee Classic.png"
         .Fill.UserPicture ThisWorkbook.Path & "\Ad Aware SE.png"
         MsgBox "Ad Aware SE"
     End With
End With
End Sub
[/vba]
Автор - nilem
Дата добавления - 04.01.2015 в 19:05
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Динамическое изменение изображения в ячейке (Макросы/Sub)
  • Страница 1 из 1
  • 1
Поиск:

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