Форум программистов
 

Восстановите пароль или Зарегистрируйтесь на форуме, о проблемах и с заказом рекламы пишите сюда - alarforum@yandex.ru, проверяйте папку спам!

Вернуться   Форум программистов > Microsoft Office и VBA программирование > Microsoft Office Excel
Регистрация

Восстановить пароль
Повторная активизация e-mail

Купить рекламу на форуме - 42 тыс руб за месяц

Ответ
 
Опции темы Поиск в этой теме
Старый 14.05.2020, 15:29   #1
Вадим12091965
Форумчанин
 
Регистрация: 21.10.2012
Сообщений: 143
По умолчанию Перестал работать код

Здравствуйте. Нашёл в интернете код для редактирования прямоугольника макросом. Прямоугольников у меня будет много, начал копировать макросы и добавлять в Private Sub Worksheet_SelectionChange(ByVal Target As Range) названия новых макросов. После третьего макроса появилась ошибка Type mismatch. Сам не разберусь. Прошу помочь.

Код:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Application.Run "Лист3.Прямоугольник1"
    Application.Run "Лист3.Прямоугольник2"
    Application.Run "Лист3.Прямоугольник3"
    Application.Run "Лист3.Прямоугольник4"
    Application.Run "Лист3.Прямоугольник5"
End Sub
Sub Прямоугольник1()
Set s = ActiveSheet.Shapes("Прямоугольник1")
    s.DrawingObject.Caption = Sheets("Выбор вставок").Range("B25") 'текст в прямоугольнике
    s.Width = Sheets("Расчёт дверей").Range("C13").Value 'ширина
    s.Height = Sheets("Расчёт дверей").Range("B13").Value 'высота
    s.Top = Sheets("Расчёт дверей").Range("B14").Value 'сверху
    s.Left = Sheets("Расчёт дверей").Range("C14").Value 'слева
End Sub
Sub Прямоугольник2()
Set s = ActiveSheet.Shapes("Прямоугольник2")
    s.DrawingObject.Caption = Sheets("Выбор вставок").Range("E25") 'текст в прямоугольнике
    s.Width = Sheets("Расчёт дверей").Range("G13").Value 'ширина
    s.Height = Sheets("Расчёт дверей").Range("F13").Value 'высота
    s.Top = Sheets("Расчёт дверей").Range("F14").Value 'сверху
    s.Left = Sheets("Расчёт дверей").Range("G14").Value 'слева
End Sub
Sub Прямоугольник3()
Set s = ActiveSheet.Shapes("Прямоугольник3")
    s.DrawingObject.Caption = Sheets("Выбор вставок").Range("B28") 'текст в прямоугольнике
    s.Width = Sheets("Расчёт дверей").Range("C17").Value 'ширина
    s.Height = Sheets("Расчёт дверей").Range("B17").Value 'высота
    s.Top = Sheets("Расчёт дверей").Range("B18").Value 'сверху
    s.Left = Sheets("Расчёт дверей").Range("C18").Value 'слева
End Sub
Sub Прямоугольник4()
Set s = ActiveSheet.Shapes("Прямоугольник4")
    s.DrawingObject.Caption = Sheets("Выбор вставок").Range("E28") 'текст в прямоугольнике
    s.Width = Sheets("Расчёт дверей").Range("G17").Value 'ширина
    s.Height = Sheets("Расчёт дверей").Range("F17").Value 'высота
    s.Top = Sheets("Расчёт дверей").Range("F18").Value 'сверху
    s.Left = Sheets("Расчёт дверей").Range("G18").Value 'слева
End Sub
Sub Прямоугольник5()
Set s = ActiveSheet.Shapes("Прямоугольник5")
    s.DrawingObject.Caption = Sheets("Выбор вставок").Range("B31") 'текст в прямоугольнике
    s.Width = Sheets("Расчёт дверей").Range("C21").Value 'ширина
    s.Height = Sheets("Расчёт дверей").Range("B21").Value 'высота
    s.Top = Sheets("Расчёт дверей").Range("B22").Value 'сверху
    s.Left = Sheets("Расчёт дверей").Range("C22").Value 'слева
End Sub
Спасибо
Вадим12091965 вне форума Ответить с цитированием
Старый 14.05.2020, 15:41   #2
Hugo121
Старожил
 
Регистрация: 11.05.2010
Сообщений: 5,166
По умолчанию

Давайте файл с этим листом с прямоугольниками и листами "Выбор вставок" и "Расчёт дверей"
webmoney: E265281470651 Z422237915069 R418926282008
Hugo121 вне форума Ответить с цитированием
Старый 14.05.2020, 18:24   #3
Вадим12091965
Форумчанин
 
Регистрация: 21.10.2012
Сообщений: 143
По умолчанию

Приложил файл
Вложения
Тип файла: zip Расчёт дверей.zip (576.0 Кб, 4 просмотров)
Вадим12091965 вне форума Ответить с цитированием
Старый 14.05.2020, 18:56   #4
Hugo121
Старожил
 
Регистрация: 11.05.2010
Сообщений: 5,166
По умолчанию

У меня отработало без сбоев. Насколько правильно - не в курсе, но все макросы отработали.
webmoney: E265281470651 Z422237915069 R418926282008
Hugo121 вне форума Ответить с цитированием
Старый 14.05.2020, 19:01   #5
Вадим12091965
Форумчанин
 
Регистрация: 21.10.2012
Сообщений: 143
По умолчанию

Мистика. Открыл файл - работает. Днем закрывал файл и снова открывал, всё-равно всплывала ошибка. Как-бы то ни было, поработаю дальше, посмотрю куда кривая вывезет. Вам спасибо
Вадим12091965 вне форума Ответить с цитированием
Старый 14.05.2020, 19:03   #6
Hugo121
Старожил
 
Регистрация: 11.05.2010
Сообщений: 5,166
По умолчанию

На какой строке ошибку выбивает?
webmoney: E265281470651 Z422237915069 R418926282008
Hugo121 вне форума Ответить с цитированием
Старый 15.05.2020, 13:06   #7
Вадим12091965
Форумчанин
 
Регистрация: 21.10.2012
Сообщений: 143
По умолчанию

Было на четвёртой. Сегодня сделал для одной двери - 20 макросов. Пока всё работает нормально. Всего будет сто макросов. Не будет глюков при таком количестве?
Хотелось бы, что бы при увеличении размера прямоугольника увеличивался шрифт текста на нём. Может напишите что добавить в код. В опциях фигур есть "подстроить фигуру под текст", но нет обратного "подстроить текст под фигуру".
Вадим12091965 вне форума Ответить с цитированием
Старый 15.05.2020, 13:38   #8
IgorGO
Новичок
СтарожилДжуниор
 
Аватар для IgorGO
 
Регистрация: 05.02.2008
Сообщений: 9,487
По умолчанию

глюков не будет, главное - мозгами не поехать
(зачем они нужны 100 шт.???)))
Программисты - это люди, решающие проблемы, о существовании которых Вы не подозревали, методами, которых Вы не понимаете
IgorGO вне форума Ответить с цитированием
Старый 15.05.2020, 13:48   #9
Aleksandr H.
2 the Nation Glory
Старожил
 
Аватар для Aleksandr H.
 
Регистрация: 27.05.2014
Сообщений: 3,289
По умолчанию

Цитата:
Сообщение от Вадим12091965 Посмотреть сообщение
Сегодня сделал для одной двери - 20 макросов.
таких запросов как в 1-ом сообщении?

Тогда следует обратить внимание на параметры процедур. Зачем 100 макросов, если можно 1 в цикле вызыватть?
https://docs.microsoft.com/ru-ru/dot...-and-arguments
Кто умер, но не забыт, тот бессмертен.
Лао-Цзы.
Aleksandr H. вне форума Ответить с цитированием
Старый 15.05.2020, 14:06   #10
Вадим12091965
Форумчанин
 
Регистрация: 21.10.2012
Сообщений: 143
По умолчанию

Сегодня всплыла ошибка на 18-м макросе. Заметил что в момент изменения формулы в ячейке. Было ЕСЛИ(....., то пусто) заменил на "то ноль" - ошибка ушла.
Вадим12091965 вне форума Ответить с цитированием
Ответ


Купить рекламу на форуме - 42 тыс руб за месяц

Опции темы Поиск в этой теме
Поиск в этой теме:

Расширенный поиск


Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Перестал работать Intellisense ninja2 Visual C++ 25 20.10.2015 16:34
Перестал работать код Оксана33 Microsoft Office Excel 6 07.10.2015 21:10
Перестал работать css impulsgraw HTML и CSS 8 22.08.2011 21:28
Перестал работать код Mikuro Microsoft Office Excel 6 12.11.2010 15:24
перестал работать cd-rom Betty Компьютерное железо 7 22.08.2009 09:10