Здравствуйте уважаемые форумчане. Во вложеном файле пытаюсь разобраться с макросом, но не могу понять взаимосвязь действия (введения значения) и результата (изменение цвета слоя) если ктонибудь прокоментирует строчки макроса и объяснить как добавлять еще объекты, буду премного премного благодарен. [vba]
Код
Private Sub Worksheet_Change(ByVal Target As Range) Const lastId As Long = 3 Const colOffset As Long = 6 Dim vColor As Long, i As Long If Not Application.Intersect(Target, Me.Range("G7:I7" ) Is Nothing Then - это где проверяется изменение значения For i = 1 To lastId With Me.Shapes("Дом" & CStr(i)) Select Case Me.Cells(Target.Row, i + colOffset).Value Case 1: .Visible = msoTrue: .Fill.ForeColor.RGB = vbRed - это покраска в зависимости от значения Case 2: .Visible = msoTrue: .Fill.ForeColor.RGB = vbYellow Case 3: .Visible = msoTrue: .Fill.ForeColor.RGB = vbGreen Case Else: .Visible = msoFalse End Select End With Next End If End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range) End Sub
[/vba]
Здравствуйте уважаемые форумчане. Во вложеном файле пытаюсь разобраться с макросом, но не могу понять взаимосвязь действия (введения значения) и результата (изменение цвета слоя) если ктонибудь прокоментирует строчки макроса и объяснить как добавлять еще объекты, буду премного премного благодарен. [vba]
Код
Private Sub Worksheet_Change(ByVal Target As Range) Const lastId As Long = 3 Const colOffset As Long = 6 Dim vColor As Long, i As Long If Not Application.Intersect(Target, Me.Range("G7:I7" ) Is Nothing Then - это где проверяется изменение значения For i = 1 To lastId With Me.Shapes("Дом" & CStr(i)) Select Case Me.Cells(Target.Row, i + colOffset).Value Case 1: .Visible = msoTrue: .Fill.ForeColor.RGB = vbRed - это покраска в зависимости от значения Case 2: .Visible = msoTrue: .Fill.ForeColor.RGB = vbYellow Case 3: .Visible = msoTrue: .Fill.ForeColor.RGB = vbGreen Case Else: .Visible = msoFalse End Select End With Next End If End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range) End Sub
prorab, соблюдайте правила форума. Выложите файл-пример. Или Вы думаете, что кто-нибудь за Вас создаст файл с картинками с именами "Дом1", "Дом2", "Дом3", … и расскажет Вам как с ними работает не Вами написанный макрос? Да и ошибки у Вас в тексте процедур - скобки не хватает в одном месте. Без файла ничего кроме этого сказать нельзя[vba]
Код
Private Sub Worksheet_Change(ByVal Target As Range) Const lastId As Long = 3 Const colOffset As Long = 6 Dim vColor As Long, i As Long If Not Application.Intersect(Target, Me.Range("G7:I7")) Is Nothing Then ' если изменились значения ячеек в диапазоне "G7:I7", то … For i = 1 To lastId With Me.Shapes("Дом" & CStr(i)) ' будем работать с картинками, имеющими имена "Дом1", "Дом2", …, "Дом" & lastId Select Case Me.Cells(Target.Row, i + colOffset).Value ' покраска картинки "Дом" в зависимости от значения в ячейке Case 1: .Visible = msoTrue: .Fill.ForeColor.RGB = vbRed Case 2: .Visible = msoTrue: .Fill.ForeColor.RGB = vbYellow Case 3: .Visible = msoTrue: .Fill.ForeColor.RGB = vbGreen Case Else: .Visible = msoFalse ' если в ячейке значение не 1, не 2 и не 3, то сделать картинку и"Дом" невидимой End Select End With Next End If End Sub
[/vba]
prorab, соблюдайте правила форума. Выложите файл-пример. Или Вы думаете, что кто-нибудь за Вас создаст файл с картинками с именами "Дом1", "Дом2", "Дом3", … и расскажет Вам как с ними работает не Вами написанный макрос? Да и ошибки у Вас в тексте процедур - скобки не хватает в одном месте. Без файла ничего кроме этого сказать нельзя[vba]
Код
Private Sub Worksheet_Change(ByVal Target As Range) Const lastId As Long = 3 Const colOffset As Long = 6 Dim vColor As Long, i As Long If Not Application.Intersect(Target, Me.Range("G7:I7")) Is Nothing Then ' если изменились значения ячеек в диапазоне "G7:I7", то … For i = 1 To lastId With Me.Shapes("Дом" & CStr(i)) ' будем работать с картинками, имеющими имена "Дом1", "Дом2", …, "Дом" & lastId Select Case Me.Cells(Target.Row, i + colOffset).Value ' покраска картинки "Дом" в зависимости от значения в ячейке Case 1: .Visible = msoTrue: .Fill.ForeColor.RGB = vbRed Case 2: .Visible = msoTrue: .Fill.ForeColor.RGB = vbYellow Case 3: .Visible = msoTrue: .Fill.ForeColor.RGB = vbGreen Case Else: .Visible = msoFalse ' если в ячейке значение не 1, не 2 и не 3, то сделать картинку и"Дом" невидимой End Select End With Next End If End Sub
Извините, вроде прикреплял ((( Alex_ST а первые три строки о чем говорят? В ячейках под Дом1 Дом2 Дом3 меняем значения от 1 до трех и видим изменение цвета над ним, макрос писал не я, но очень надо разобраться. Как макрос понимает что связь идет между ячейкой Дом1 и картинкой Дом1, как добавить еще одну категорию объектов(картинку с другим именем) чтоб все работало?
Извините, вроде прикреплял ((( Alex_ST а первые три строки о чем говорят? В ячейках под Дом1 Дом2 Дом3 меняем значения от 1 до трех и видим изменение цвета над ним, макрос писал не я, но очень надо разобраться. Как макрос понимает что связь идет между ячейкой Дом1 и картинкой Дом1, как добавить еще одну категорию объектов(картинку с другим именем) чтоб все работало?prorab
Ну, как добавлять-то, наверное понятно: добавляете любой рисунок, даёте ему имя Дом с какой-нибудь очередной цифрой, а в процедуре соответственно увеличиваете величину константы lastId Только ведь Вам ещё, наверное, понадобится и диапазон под номерами домов расширять синхронно... Это сделать не сложно. Но вообще-то лучше бы немного упростить код так, чтобы количество домов нужно было вводить только один раз[vba]
Код
Private Sub Worksheet_Change(ByVal Target As Range) Const lastId As Integer = 6 ' количество домов Dim i As Integer If Not Application.Intersect(Target, Me.Range("G7").Resize(1, lastId)) Is Nothing Then For i = 1 To lastId With Me.Shapes("Дом" & CStr(i)) Select Case Me.Cells(Target.Row, i + Target.Row - 1).Value Case 1: .Visible = True: .Fill.ForeColor.RGB = vbRed Case 2: .Visible = True: .Fill.ForeColor.RGB = vbYellow Case 3: .Visible = True: .Fill.ForeColor.RGB = vbGreen Case 4: .Visible = True: .Fill.ForeColor.RGB = vbBlue Case 5: .Visible = True: .Fill.ForeColor.RGB = vbMagenta Case 6: .Visible = True: .Fill.ForeColor.RGB = vbCyan Case Else: .Visible = False End Select End With Next End If End Sub
[/vba] А уж названия домов Вы сами над строкой с номерами цветов пропишите. А ещё на листе есть и "хотелка" про переход по дблклику по картинке на соответствующий лист. Но уж это, извините, делать не буду, т.к. с картинками проблема - клики и даблклики по ним не вызывают нормальных программных событий, да и имена картинок на листе могут быть не уникальными. Поэтому приходится лепить всякие хитрые "костыли". А мне лень.
Ну, как добавлять-то, наверное понятно: добавляете любой рисунок, даёте ему имя Дом с какой-нибудь очередной цифрой, а в процедуре соответственно увеличиваете величину константы lastId Только ведь Вам ещё, наверное, понадобится и диапазон под номерами домов расширять синхронно... Это сделать не сложно. Но вообще-то лучше бы немного упростить код так, чтобы количество домов нужно было вводить только один раз[vba]
Код
Private Sub Worksheet_Change(ByVal Target As Range) Const lastId As Integer = 6 ' количество домов Dim i As Integer If Not Application.Intersect(Target, Me.Range("G7").Resize(1, lastId)) Is Nothing Then For i = 1 To lastId With Me.Shapes("Дом" & CStr(i)) Select Case Me.Cells(Target.Row, i + Target.Row - 1).Value Case 1: .Visible = True: .Fill.ForeColor.RGB = vbRed Case 2: .Visible = True: .Fill.ForeColor.RGB = vbYellow Case 3: .Visible = True: .Fill.ForeColor.RGB = vbGreen Case 4: .Visible = True: .Fill.ForeColor.RGB = vbBlue Case 5: .Visible = True: .Fill.ForeColor.RGB = vbMagenta Case 6: .Visible = True: .Fill.ForeColor.RGB = vbCyan Case Else: .Visible = False End Select End With Next End If End Sub
[/vba] А уж названия домов Вы сами над строкой с номерами цветов пропишите. А ещё на листе есть и "хотелка" про переход по дблклику по картинке на соответствующий лист. Но уж это, извините, делать не буду, т.к. с картинками проблема - клики и даблклики по ним не вызывают нормальных программных событий, да и имена картинок на листе могут быть не уникальными. Поэтому приходится лепить всякие хитрые "костыли". А мне лень.Alex_ST
Извините Alex_ST но я видимо неправильно сформулировал вопрос. Не надо создавать многоцветную палитру, достаточно светофорных цветов, я имею ввиду если уменя появится объект Парковка, как это записать на VBA чтоб работало ? (во вложении 3 полигона имеют имя Дом 1,2,3 и 3 полигона с именем Парковка1,2,3)
Извините Alex_ST но я видимо неправильно сформулировал вопрос. Не надо создавать многоцветную палитру, достаточно светофорных цветов, я имею ввиду если уменя появится объект Парковка, как это записать на VBA чтоб работало ? (во вложении 3 полигона имеют имя Дом 1,2,3 и 3 полигона с именем Парковка1,2,3)prorab
Ну, "радуга" - это для наглядности. Если Вам нужен "светофор", то просто заремарьте или вообще удалите не нужные строки. Хоть мне и не нравится Ваша структура представления данных, т.к. возможны ошибки в написании имён объектов, да и переименовывать их при создании новых не слишком-то удобно, но по Вашим "хотелкам" можно сделать, например, так:[vba]
Код
Private Sub Worksheet_Change(ByVal Target As Range) ' обработка события изменения на листе Dim rCell As Range, rColors As Range, rNames As Range, iShape As Shape, iDomCol%, iParkCol% Dim sAddrStart$: sAddrStart = "G7" For Each iShape In Me.Shapes ' количества рисунков домов и парковок на листе лучше не задавать, а посчитать If iShape.Name Like "Дом" & "?" Then iDomCol = iDomCol + 1 ' считаем количество домов If iShape.Name Like "Парковка" & "?" Then iParkCol = iParkCol + 1 ' считаем количество парковок Next iShape Set rColors = Me.Range(sAddrStart).Resize(1, iDomCol + iParkCol) ' диапазон с цветами картинок Set rNames = rColors.Offset(-1, 0) ' диапазон с именами картинок на строку выше If Not Intersect(Target, rColors) Is Nothing Then ' если изменили что-то в диапазоне с цветами картинок For Each rCell In rNames ' перебираем ячейки в диапазоне с именами картинок On Error GoTo neXxt ' чтобы не было ошибки если имя написано не правильно With Me.Shapes(rCell) ' для картинки с именем, заданным в ячейке rCell Select Case rCell.Offset(1, 0).Value ' в зависимости от значения в ячейке ниже управляем картинкой Case 1: .Visible = True: .Fill.ForeColor.RGB = vbRed Case 2: .Visible = True: .Fill.ForeColor.RGB = vbYellow Case 3: .Visible = True: .Fill.ForeColor.RGB = vbGreen Case 4: .Visible = True: .Fill.ForeColor.RGB = vbBlue Case 5: .Visible = True: .Fill.ForeColor.RGB = vbMagenta Case 6: .Visible = True: .Fill.ForeColor.RGB = vbCyan Case Else: .Visible = False End Select End With neXxt: Next rCell End If End Sub
[/vba] Но на Вашем месте я бы как минимум не задавал адрес начала отсчёта цветов напрямую "G7", а этой ячейке на листе присвоил бы какое-нибудь имя (ну, например, НАЧАЛО) и в коде исправил бы sAddrStart = "G7" на sAddrStart = "НАЧАЛО" Тогда Вы сможете свободно перемещать свою таблицу цветов по листу, т.к. присвоенное имя будет перемещаться вместе с ячейками.
Ну, "радуга" - это для наглядности. Если Вам нужен "светофор", то просто заремарьте или вообще удалите не нужные строки. Хоть мне и не нравится Ваша структура представления данных, т.к. возможны ошибки в написании имён объектов, да и переименовывать их при создании новых не слишком-то удобно, но по Вашим "хотелкам" можно сделать, например, так:[vba]
Код
Private Sub Worksheet_Change(ByVal Target As Range) ' обработка события изменения на листе Dim rCell As Range, rColors As Range, rNames As Range, iShape As Shape, iDomCol%, iParkCol% Dim sAddrStart$: sAddrStart = "G7" For Each iShape In Me.Shapes ' количества рисунков домов и парковок на листе лучше не задавать, а посчитать If iShape.Name Like "Дом" & "?" Then iDomCol = iDomCol + 1 ' считаем количество домов If iShape.Name Like "Парковка" & "?" Then iParkCol = iParkCol + 1 ' считаем количество парковок Next iShape Set rColors = Me.Range(sAddrStart).Resize(1, iDomCol + iParkCol) ' диапазон с цветами картинок Set rNames = rColors.Offset(-1, 0) ' диапазон с именами картинок на строку выше If Not Intersect(Target, rColors) Is Nothing Then ' если изменили что-то в диапазоне с цветами картинок For Each rCell In rNames ' перебираем ячейки в диапазоне с именами картинок On Error GoTo neXxt ' чтобы не было ошибки если имя написано не правильно With Me.Shapes(rCell) ' для картинки с именем, заданным в ячейке rCell Select Case rCell.Offset(1, 0).Value ' в зависимости от значения в ячейке ниже управляем картинкой Case 1: .Visible = True: .Fill.ForeColor.RGB = vbRed Case 2: .Visible = True: .Fill.ForeColor.RGB = vbYellow Case 3: .Visible = True: .Fill.ForeColor.RGB = vbGreen Case 4: .Visible = True: .Fill.ForeColor.RGB = vbBlue Case 5: .Visible = True: .Fill.ForeColor.RGB = vbMagenta Case 6: .Visible = True: .Fill.ForeColor.RGB = vbCyan Case Else: .Visible = False End Select End With neXxt: Next rCell End If End Sub
[/vba] Но на Вашем месте я бы как минимум не задавал адрес начала отсчёта цветов напрямую "G7", а этой ячейке на листе присвоил бы какое-нибудь имя (ну, например, НАЧАЛО) и в коде исправил бы sAddrStart = "G7" на sAddrStart = "НАЧАЛО" Тогда Вы сможете свободно перемещать свою таблицу цветов по листу, т.к. присвоенное имя будет перемещаться вместе с ячейками.Alex_ST
Спасибо )) теперь буду разбиратся что куда зачем. Но сразу вопрос от недогоняющего If iShape.Name Like "Дом" & "?" Then iDomCol = iDomCol + 1 в этой строке сказать экселю что например при названии "Дом-7-2-1", команда iDomCol + 1 (единица плюсовалась к последней цифре).
Спасибо )) теперь буду разбиратся что куда зачем. Но сразу вопрос от недогоняющего If iShape.Name Like "Дом" & "?" Then iDomCol = iDomCol + 1 в этой строке сказать экселю что например при названии "Дом-7-2-1", команда iDomCol + 1 (единица плюсовалась к последней цифре).prorab
Сообщение отредактировал prorab - Пятница, 02.05.2014, 18:16
prorab, а у Вас кнопка F1 на клавиатуре отсутствует? Читайте Справку по оператору Like. [vba]
Код
Like "Дом" & "?"
[/vba] означает стринг с ОДНИМ любым символом после слова Дом. Если Вам нужно неизвестно сколько символов после Дом, то используйте *
Но, к стати, ни о каких "Дом-7-2-1" в Вашем 1-м примере речи быть и не могло в принципе. Там были возможны только Дом с цифрой без всяких знаков препинания.
prorab, а у Вас кнопка F1 на клавиатуре отсутствует? Читайте Справку по оператору Like. [vba]
Код
Like "Дом" & "?"
[/vba] означает стринг с ОДНИМ любым символом после слова Дом. Если Вам нужно неизвестно сколько символов после Дом, то используйте *
Но, к стати, ни о каких "Дом-7-2-1" в Вашем 1-м примере речи быть и не могло в принципе. Там были возможны только Дом с цифрой без всяких знаков препинания.Alex_ST
С уважением, Алексей MS Excel 2003 - the best!!!
Сообщение отредактировал Alex_ST - Пятница, 02.05.2014, 19:14
F1 присутствует, признаю.Тему будем считать закрытой, первоначальный вопрос раскрыт полностью и даже с дополнения за что отдельная благодарность Alex_ST. Спасибо всем участникам.
F1 присутствует, признаю.Тему будем считать закрытой, первоначальный вопрос раскрыт полностью и даже с дополнения за что отдельная благодарность Alex_ST. Спасибо всем участникам.prorab
Сообщение отредактировал prorab - Пятница, 02.05.2014, 19:25