|
|
Регистрация Восстановить пароль |
Повторная активизация e-mail |
Регистрация | Задать вопрос |
Заплачу за решение |
Новые сообщения |
Сообщения за день |
Расширенный поиск |
Правила |
Всё прочитано |
|
Опции темы | Поиск в этой теме |
13.04.2010, 16:15 | #1 |
Пользователь
Регистрация: 13.04.2010
Сообщений: 17
|
Изменение цвета объектов по заданным параметрам.
Привет всем! Помогите пожалуйста, новичку в VBA, решить следующюю задачку:
На Лист1 размещены окружности Lmp101, Lmp102.... и т.д. На Лист2 размещены окружности Lmp201, Lmp202.... и т.д. На листе Данные таблица из 2-х столбцов: ID - Цвет 101 - красный 102 - зеленый ................... 201 - зеленый 202 - зеленый .........и т.д. При загрузке книги окружности автоматически должны быть закрашены соответствующим цветом: например Lmp101 - красным, Lmp202 - зеленым. Не могу сообразить, как при выборке по цвету (столбцу 2) перейти от соответствующего значения ID (в столбце 1) к имени окружности Lmp101, Lmp102... Заранее спасибо. |
13.04.2010, 17:23 | #2 |
Форумчанин
Регистрация: 06.08.2009
Сообщений: 472
|
например, так, см. вложение
|
14.04.2010, 14:54 | #3 |
Пользователь
Регистрация: 13.04.2010
Сообщений: 17
|
Большое спасибо. Пробую сделать по свои условия.
|
15.04.2010, 15:03 | #4 |
Пользователь
Регистрация: 13.04.2010
Сообщений: 17
|
Поскольку у меня объекты и данные размещены на разных листах, сделал так:
Private Sub workbook_open() Dim i As Integer Dim num As Integer Dim ws1 As Worksheet Dim ws2 As Worksheet Dim ws3 As Worksheet Set ws1 = ThisWorkbook.Worksheets(1) Set ws2 = ThisWorkbook.Worksheets(2) Set ws3 = ThisWorkbook.Worksheets(3) i = 2 For Each Cell In ws3.Range(("a2"), ws3.Range("a" & Rows.Count).End(xlUp)) num = ws3.Cells(i, 1) If (num > 200) And (num < 300) Then ws1.Shapes("shape" & num).Select Selection.ShapeRange.Fill.Solid Selection.ShapeRange.Fill.Visible = msoTrue: If ws3.Cells(i, 2).Value = "Красный" Then Selection.ShapeRange.Fill.ForeColor .SchemeColor = 2 If ws3.Cells(i, 2).Value = "Зеленый" Then Selection.ShapeRange.Fill.ForeColor .SchemeColor = 3 If ws3.Cells(i, 2).Value = "Синий" Then Selection.ShapeRange.Fill.ForeColor .SchemeColor = 4 ws1.Cells(10, i).Value = num 'вывод номера объекта для проверки ws1.Cells(18, i).Value = ws3.Cells(i, 2).Value 'вывод названия цвета объекта для проверки End If If (num > 300) And (num < 400) Then ws2.Shapes("shape" & num).Select Selection.ShapeRange.Fill.Solid Selection.ShapeRange.Fill.Visible = msoTrue: If ws3.Cells(i, 2).Value = "Красный" Then Selection.ShapeRange.Fill.ForeColor .SchemeColor = 2 If ws3.Cells(i, 2).Value = "Зеленый" Then Selection.ShapeRange.Fill.ForeColor .SchemeColor = 3 If ws3.Cells(i, 2).Value = "Синий" Then Selection.ShapeRange.Fill.ForeColor .SchemeColor = 4 ws2.Cells(10, i - 10).Value = num ws2.Cells(18, i - 10).Value = ws3.Cells(i, 2).Value End If i = i + 1 Next End Sub Все почти работает... Есть вопросы. Самый главный - не пойму, откуда вылезает ошибка при закрашивании (см. прилагаемый файл - выделил рамкой). Второй - все работает только когда активен Лист1, если активен Лист2 или Данные - выдает ошибку. Возможно ли сделать так, что я меняю на листе с данными цвет n-го круга и переключаясь на лист с этим кругом вижу его уже с новым цветом. |
15.04.2010, 17:04 | #5 |
Форумчанин
Регистрация: 13.01.2010
Сообщений: 410
|
Код:
|
15.04.2010, 17:57 | #6 |
Пользователь
Регистрация: 13.04.2010
Сообщений: 17
|
Блин. Как все просто Огромное спасибо.
|
15.04.2010, 17:57 | #7 |
Форумчанин
Регистрация: 06.08.2009
Сообщений: 472
|
если я Вас правильно понял, можно сделать, например, так, см. вложение
|
Похожие темы | ||||
Тема | Автор | Раздел | Ответов | Последнее сообщение |
Добовление строки по заданным параметрам | grichanuk | Microsoft Office Excel | 2 | 07.04.2010 23:34 |
QBasic, массивы, заполнение одного элементами другого по заданным параметрам | Mik86 | Помощь студентам | 1 | 17.03.2010 14:39 |
Построение матрицы в VBA по заданным параметрам. | krmn | Помощь студентам | 5 | 24.12.2009 19:26 |
Открытие сторонних приложений по заданным параметрам | skalt12 | Общие вопросы Delphi | 6 | 16.08.2009 19:23 |
Автоматический поиск ячейки по заданным параметрам | Renzo | Microsoft Office Excel | 5 | 07.03.2009 17:48 |