Значение ячейки = тексту автофигуры - Мир MS Excel

Регистрация

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

= Мир MS Excel/Значение ячейки = тексту автофигуры - Мир MS Excel

Старая форма входа

Страница 1 из 1 1
Модератор форума: китин, _Boroda_

Значение ячейки = тексту автофигуры

Значение ячейки = тексту автофигуры

Дата: Пятница, 09.09.2011, 07:14 | Сообщение № 1

Группа: Проверенные

Ранг: Прохожий

Сообщений: 8

Репутация: 8 ±

Замечаний: 0% ±

Здравствуйте, уважаемые знатоки Excel!

Как прописать в макросе, чтобы значение ячейки было равно тексту из автофигуры Прямоугольник?
А если Прямоугольник сгруппирован с другими фигурами, тогда как?

Здесь есть похожее (http://www.excelworld.ru/forum/3-647-1), но я не смог применить.

Покажите пожалуйста на моём примере.

К сообщению приложен файл: __.xls (30.5 Kb)

С уважением, Влад.

Ответить

Дата: Пятница, 09.09.2011, 09:40 | Сообщение № 2

Группа: Админы

Ранг: Местный житель

Сообщений: 16714

Репутация: 6503 ±

Замечаний: ±

2003; 2007; 2010; 2013 RUS

Именно для этих фигур можно так

Code

Sub Макрос3()
Application.ScreenUpdating = 0
a_ = Selection.Address
        ActiveSheet.Shapes.Range(Array("Rectangle 1")).Select
        Range("B2") = Selection.ShapeRange(1).TextFrame2.TextRange.Characters.Text
        ActiveSheet.Shapes.Range(Array("Прямоуг. 2")).Select
        Range("B8") = Selection.ShapeRange(1).TextFrame2.TextRange.Characters.Text
        ActiveSheet.Shapes.Range(Array("Поле 3")).Select
        Range("B17") = Selection.ShapeRange(1).TextFrame2.TextRange.Characters.Text
Range(a_).Select
Application.ScreenUpdating = 1
End Sub

У меня на работе винда и офис 64-х битные. Офис 2010

К сообщению приложен файл: 454543_2_.xls (54.5 Kb)

Скажи мне, кудесник, любимец ба’гов...
Платная помощь:
Boroda_Excel@mail.ru
Яндекс-деньги: 41001632713405 | Webmoney: R289877159277; Z102172301748; E177867141995

Ответить

Дата: Пятница, 09.09.2011, 09:51 | Сообщение № 3

Группа: Друзья

Ранг: Старожил

Сообщений: 2012

Репутация: 373 ±

Замечаний: 0% ±

Excel2016

_Boroda_, исправьте, в предпоследней строчке ошибка, должно быть

Code

Application.ScreenUpdating = 1

И в файле тоже

Сообщение отредактировал Michael_S - Пятница, 09.09.2011, 09:52

Ответить

Формуляр

Дата: Пятница, 09.09.2011, 13:23 | Сообщение № 4

Группа: Друзья

Ранг: Ветеран

Сообщений: 832

Репутация: 255 ±

Замечаний: 0% ±

Excel 2003, 2013

_Boroda_,
а у меня эта штука работать не желает:
свойство TextFrame2, говорит, не определено.
Более того,

Code

ActiveSheet.Shapes.Range(Array("Прямоуг. 2"))

- объект не находит.

С чего бы это?
Может - версия? wacko

wacko

Excel 2003 EN, 2013 EN

Ответить

Дата: Пятница, 09.09.2011, 13:59 | Сообщение № 5

Группа: Друзья

Ранг: Участник клуба

Сообщений: 3690

Репутация: 790 ±

Замечаний: 0% ±

365

У меня на 2003 спотыкается тоже уже на
Range("B2") = Selection.ShapeRange(1).TextFrame2.TextRange.Characters.Text

webmoney: E265281470651 Z422237915069
USDT TRC20: TN8XeEF17o5KPBD9pNwYzNyruycuAc2mVD

Ответить

Формуляр

Дата: Пятница, 09.09.2011, 13:59 | Сообщение № 6

Группа: Друзья

Ранг: Ветеран

Сообщений: 832

Репутация: 255 ±

Замечаний: 0% ±

Excel 2003, 2013

Попытался написать UDF - получился полный изврат. (Однако работает)
Фигуру пришлось искать перебором,
а текст вычленять из AlternativeText()
По-другому что-то не выходит... sad

sad

Общий заход мне представляется принципиально проблемным.
Если привязывать текст не от фигуры к ячейке, а наоборот, от ячейки к фигуре - то и огород городить не придётся.

К сообщению приложен файл: 0416118.xls (37.0 Kb)

Excel 2003 EN, 2013 EN

Сообщение отредактировал Формуляр - Пятница, 09.09.2011, 14:02

Ответить

Дата: Пятница, 09.09.2011, 17:13 | Сообщение № 7

Группа: Проверенные

Ранг: Прохожий

Сообщений: 8

Репутация: 8 ±

Замечаний: 0% ±

Спасибо!
Но худо-бедно работает только UDF из предыдущего поста. Всё время надо пересчитывать нажатием Ctrl+Alt+F9 (по F9 не работает).

Код из первых постов спотыкается также на строчке:
Range("B2") = Selection.ShapeRange(1).TextFrame2.TextRange.Characters.Text

Вот так значение автоматом берётся из не сгруппированного текстового поля
(в модуле листа):
Sub Worksheet_SelectionChange(ByVal Target As Range)
[B2] = ActiveSheet.DrawingObjects("Поле 1").Text
End Sub

Но почему не работает так? [B2] = ActiveSheet.DrawingObjects("Прямоуг. 1").Text

С уважением, Влад.

Ответить

Дата: Пятница, 09.09.2011, 17:39 | Сообщение № 8

Группа: Друзья

Ранг: Экселист

Сообщений: 5660

Репутация: 1163 ±

Замечаний: 0% ±

2010

Quote (Влад)

Но почему не работает так? [B2] = ActiveSheet.DrawingObjects("Прямоуг. 1").Text

У меня работает и не пищит. (2007)

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

Ответить

Дата: Пятница, 09.09.2011, 17:56 | Сообщение № 9

Группа: Проверенные

Ранг: Прохожий

Сообщений: 8

Репутация: 8 ±

Замечаний: 0% ±

Quote (RAN)

У меня работает и не пищит. (2007)

И у меня не пищит, но всё-равно не работает biggrin

biggrin

Пишет - ошибка 1004: Невозможно получить свойство DrawingObjects класса Worksheet

Вообще, мне непонятно, что за объект получается, если создаём Прямоугольник и чтобы в нём что-то написать, щёлкаем текстовое Поле - потом на Прямоугольнике.
Тогда в прямоугольнике можно писать текст, но куда девается объект Поле?

К сообщению приложен файл: ___.xls (38.5 Kb)

С уважением, Влад.

Ответить

Формуляр

Дата: Пятница, 09.09.2011, 18:31 | Сообщение № 10

Группа: Друзья

Ранг: Ветеран

Сообщений: 832

Репутация: 255 ±

Замечаний: 0% ±

Excel 2003, 2013

Влад,
ознакомился на "Планете" с общим контекстом проблемы.
Может как-то по-проще, всё-таки?
Например, как в Прямоуг. 2

К сообщению приложен файл: 7870267.xls (35.5 Kb)

Excel 2003 EN, 2013 EN

Ответить

Дата: Пятница, 09.09.2011, 18:33 | Сообщение № 11

Группа: Друзья

Ранг: Экселист

Сообщений: 5660

Репутация: 1163 ±

Замечаний: 0% ±

2010

Влад, а у меня и на другом компе не пищит. biggrin

biggrin

И работает все из твоего файла! smile

smile

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

Ответить

Дата: Пятница, 09.09.2011, 19:11 | Сообщение № 12

Группа: Проверенные

Ранг: Прохожий

Сообщений: 8

Репутация: 8 ±

Замечаний: 0% ±

Quote (Формуляр)

Может как-то по-проще, всё-таки?
Например, как в Прямоуг. 2

Да, так, конечно проще, если надо, чтобы в автофигуре отображался текст из ячейки.

А когда надо наоборот, чтобы в ячейке отображался текст из автофигуры, да ещё сгруппированной, то как?
Кроме UDF (от Формуляр) пока ничего рабочего нет.

И почему не работает в иодуле листа

Sub Worksheet_SelectionChange(ByVal Target As Range)
[B2] = ActiveSheet.DrawingObjects("Прямоуг. 1").Text
End Sub

Неужели у других работает?

К сообщению приложен файл: 0014822.xls (30.5 Kb)

С уважением, Влад.

Ответить

Дата: Пятница, 09.09.2011, 19:39 | Сообщение № 13

Группа: Друзья

Ранг: Экселист

Сообщений: 5660

Репутация: 1163 ±

Замечаний: 0% ±

2010

tongue

К сообщению приложен файл: 7459988.jpg (9.2 Kb)

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

Ответить

Дата: Пятница, 09.09.2011, 19:45 | Сообщение № 14

Группа: Проверенные

Ранг: Прохожий

Сообщений: 8

Репутация: 8 ±

Замечаний: 0% ±

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

Как же всё-таки связать ячейку с автофигурой из группы? cry

cry

С уважением, Влад.

Ответить

Дата: Пятница, 09.09.2011, 22:47 | Сообщение № 15

Группа: Проверенные

Ранг: Прохожий

Сообщений: 8

Репутация: 8 ±

Замечаний: 0% ±

Решение есть! С Планеты http://www.planetaexcel.ru/forum.php?thread_id=31507. Итак:

1. Чтобы автоматом извлекать в ячейку A1 надпись из автофигуры Прямоуг. 1, вставляем в модуль листа

Sub Worksheet_SelectionChange(ByVal Target As Range)
[A1] = ActiveSheet.Shapes("Прямоуг. 1").OLEFormat.Object.Text
End Sub

2. Чтобы автоматом извлекать в ячейку A1 надпись из автофигуры Поле 1, входящей в состав сгруппированных автофигур Группа 1, вставляем в модуль листа

Sub Worksheet_SelectionChange(ByVal Target As Range)
x = ActiveSheet.Shapes("Группа 1").GroupItems("Поле 1").AlternativeText
[A1] = Replace(x, "Подпись: ", "")
End Sub

3. Чтобы автоматом вставлять в надпись автофигуры Прямоуг. 1 (сгруппированной или нет) значение из ячейки A1, выделяем Прямоуг. 1 и в строке формул пишем =A1

Спасибо всем за участие!

К сообщению приложен файл: 3301052.xls (50.5 Kb)

С уважением, Влад.

Сообщение отредактировал Влад - Пятница, 09.09.2011, 23:57

Ответить

Формуляр

Дата: Воскресенье, 11.09.2011, 12:19 | Сообщение № 16

Группа: Друзья

Ранг: Ветеран

Сообщений: 832

Репутация: 255 ±

Замечаний: 0% ±

Excel 2003, 2013

Quote (Влад)

[A1] = Replace(x, "Подпись: ", "")

подходит только для данного типа фигуры и только в русской локализации.
Универсальный вариант

Code

Mid$(x, InStr(x, ": ") + 2)

Excel 2003 EN, 2013 EN

Сообщение отредактировал Формуляр - Воскресенье, 11.09.2011, 12:21

Ответить

Дата: Понедельник, 12.09.2011, 06:35 | Сообщение № 17

Группа: Друзья

Ранг: Форумчанин

Сообщений: 116

Репутация: 41 ±

Замечаний: 0% ±

10

UDF и процедура на клик по фигуре, возможно Вам пригодится...

К сообщению приложен файл: Shape_.xls (70.5 Kb)

Всем удачи. У нас все получится.
С уважением, Владимир.

Сообщение отредактировал VovaK - Понедельник, 12.09.2011, 21:12

Ответить

Дата: Понедельник, 12.09.2011, 17:26 | Сообщение № 18

Группа: Проверенные

Ранг: Прохожий

Сообщений: 8

Репутация: 8 ±

Замечаний: 0% ±

Спасибо, Владимир!
Классная штука! Пригодится обязательно.

С уважением, Влад.

Ответить

Дата: Понедельник, 12.09.2011, 21:15 | Сообщение № 19

Группа: Друзья

Ранг: Форумчанин

Сообщений: 116

Репутация: 41 ±

Замечаний: 0% ±

10

Для 2007 нашел ошибку в Sub MakeArray()
Отсутствовал On Error resume Next перед строкой Arr(n, 1) = Shp.TextFrame.Characters.Text - выдавал ошибку для фигур не имеюших этого свойства.
исправил вложение...

Всем удачи. У нас все получится.
С уважением, Владимир.

Сообщение отредактировал VovaK - Понедельник, 12.09.2011, 21:16

Ответить

Значение ячейки = тексту автофигуры

Страница 1 из 1
1

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