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

Вход

Регистрация

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

 

= Мир MS Excel/как заставить автофигуры изменить форму с сохранением текста - Мир MS Excel

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

Excel 2007
Добрый вечер. Помогите разобраться.

На листе находится несколько Автофигур, среди них есть Прямоугольники.
В каждую Автофигуру вписан текст.
В ячейке B8 - вписан тип Автофигуры, форму которой планируется поменять - на тип, вписанный в ячейку C8.

Как макросом совершить преобразование всех Автофигур того типа, который вписан в ячейку B8 - на тот тип Автофигур, который вписан в ячейку C8 - с сохранением текста вписанного в них ?
Событие - щелчок по кнопке.

Сейчас в файле схематично показано - что все прямоугольники должны изменить форму с прямоугольной - на овальную, с сохранением текста вписанного в них.
Под изменением формы я понимаю, судя по всему - удаление Автофигуры прямоугольника с предварительным копированием текста - и создание другой Автофигуры со вставкой скопированного текста в нее.
К сообщению приложен файл: 8906536.xls (54.5 Kb)
 
Ответить
СообщениеДобрый вечер. Помогите разобраться.

На листе находится несколько Автофигур, среди них есть Прямоугольники.
В каждую Автофигуру вписан текст.
В ячейке B8 - вписан тип Автофигуры, форму которой планируется поменять - на тип, вписанный в ячейку C8.

Как макросом совершить преобразование всех Автофигур того типа, который вписан в ячейку B8 - на тот тип Автофигур, который вписан в ячейку C8 - с сохранением текста вписанного в них ?
Событие - щелчок по кнопке.

Сейчас в файле схематично показано - что все прямоугольники должны изменить форму с прямоугольной - на овальную, с сохранением текста вписанного в них.
Под изменением формы я понимаю, судя по всему - удаление Автофигуры прямоугольника с предварительным копированием текста - и создание другой Автофигуры со вставкой скопированного текста в нее.

Автор - Grell
Дата добавления - 22.04.2017 в 19:42
nilem Дата: Воскресенье, 23.04.2017, 06:46 | Сообщение № 2
Группа: Авторы
Ранг: Старожил
Сообщений: 1613
Репутация: 563 ±
Замечаний: 0% ±

Excel 2013, 2016
макрорекордер записал так:
[vba]
Код
Sub Макрос3()
'Rectangle --> Oval
ActiveSheet.Shapes("Rectangle 2").AutoShapeType = msoShapeOval
''Oval --> Rectangle
'ActiveSheet.Shapes("Oval 2").AutoShapeType = msoShapeRectangle
End Sub
[/vba]


Яндекс.Деньги 4100159601573
 
Ответить
Сообщениемакрорекордер записал так:
[vba]
Код
Sub Макрос3()
'Rectangle --> Oval
ActiveSheet.Shapes("Rectangle 2").AutoShapeType = msoShapeOval
''Oval --> Rectangle
'ActiveSheet.Shapes("Oval 2").AutoShapeType = msoShapeRectangle
End Sub
[/vba]

Автор - nilem
Дата добавления - 23.04.2017 в 06:46
Grell Дата: Воскресенье, 23.04.2017, 15:11 | Сообщение № 3
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 113
Репутация: 0 ±
Замечаний: 60% ±

Excel 2007
nilem, такое решение не подходит.

Потому что суть в том, что выбирать автофигуры для изменения - ПО ТИПУ, который вписан в ячейку B8.
И менять их форму - на тот ТИП, который вписан в ячейку C8.

То есть - не одну автофигуру, а все автофигуры - имеющие указанный тип - неважно сколько их всего на листе.
 
Ответить
Сообщениеnilem, такое решение не подходит.

Потому что суть в том, что выбирать автофигуры для изменения - ПО ТИПУ, который вписан в ячейку B8.
И менять их форму - на тот ТИП, который вписан в ячейку C8.

То есть - не одну автофигуру, а все автофигуры - имеющие указанный тип - неважно сколько их всего на листе.

Автор - Grell
Дата добавления - 23.04.2017 в 15:11
nilem Дата: Воскресенье, 23.04.2017, 15:29 | Сообщение № 4
Группа: Авторы
Ранг: Старожил
Сообщений: 1613
Репутация: 563 ±
Замечаний: 0% ±

Excel 2013, 2016
Можно завернуть в цикл. Только лучше вместо Rectangle и Oval записать их числовые выражения 1 и 9
[vba]
Код
Sub Макрос33()
Dim shp As Shape, i&, j&
i = [b8] '1 msoShapeRectangle
j = [c8] '9 msoShapeOval

For Each shp In ActiveSheet.Shapes
    If shp.AutoShapeType = i Then shp.AutoShapeType = j
Next shp
End Sub
[/vba]


Яндекс.Деньги 4100159601573
 
Ответить
СообщениеМожно завернуть в цикл. Только лучше вместо Rectangle и Oval записать их числовые выражения 1 и 9
[vba]
Код
Sub Макрос33()
Dim shp As Shape, i&, j&
i = [b8] '1 msoShapeRectangle
j = [c8] '9 msoShapeOval

For Each shp In ActiveSheet.Shapes
    If shp.AutoShapeType = i Then shp.AutoShapeType = j
Next shp
End Sub
[/vba]

Автор - nilem
Дата добавления - 23.04.2017 в 15:29
Grell Дата: Воскресенье, 23.04.2017, 19:53 | Сообщение № 5
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 113
Репутация: 0 ±
Замечаний: 60% ±

Excel 2007
nilem,не работает.

Пишет "Run-time error '13': Type mismatch"
 
Ответить
Сообщениеnilem,не работает.

Пишет "Run-time error '13': Type mismatch"

Автор - Grell
Дата добавления - 23.04.2017 в 19:53
Pelena Дата: Воскресенье, 23.04.2017, 20:34 | Сообщение № 6
Группа: Админы
Ранг: Местный житель
Сообщений: 19167
Репутация: 4412 ±
Замечаний: ±

Excel 365 & Mac Excel
Если выполнить рекомендацию
вместо Rectangle и Oval записать их числовые выражения 1 и 9
, то всё работает


"Черт возьми, Холмс! Но как??!!"
Ю-money 41001765434816
 
Ответить
СообщениеЕсли выполнить рекомендацию
вместо Rectangle и Oval записать их числовые выражения 1 и 9
, то всё работает

Автор - Pelena
Дата добавления - 23.04.2017 в 20:34
Grell Дата: Воскресенье, 23.04.2017, 22:25 | Сообщение № 7
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 113
Репутация: 0 ±
Замечаний: 60% ±

Excel 2007
nilem, все работает.
Спасибо.
 
Ответить
Сообщениеnilem, все работает.
Спасибо.

Автор - Grell
Дата добавления - 23.04.2017 в 22:25
Мир MS Excel » Вопросы и решения » Вопросы по VBA » как заставить автофигуры изменить форму с сохранением текста (Макросы/Sub)
  • Страница 1 из 1
  • 1
Поиск:

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