Как дать ссылку на событие другого листа?

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

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

Как дать ссылку на событие другого листа? (Макросы/Sub)

kotlovan

Дата: Понедельник, 24.06.2019, 10:30 | Сообщение № 1

Группа: Пользователи

Ранг: Новичок

Сообщений: 30

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

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

Excel 2013

Добрый день!
Цвет фигур первых двух блоков на первом листе ссылается на значения этого же листа. Происходит автоизменение цвета фигур.
Вопрос: как сделать так, чтобы третий блок фигур, ссылающийся на значения листа2 тоже менялся?

[vba]

Код

Sub Worksheet_Change(ByVal Target As Range)
    Select Case Target.Address(0, 0)
        Case "H3"
            Set shp_1 = ActiveSheet.Shapes("СтрОтправлено")
            Set shp_2 = ActiveSheet.Shapes("ТекстОтправлено")
        Case "E3"
            Set shp_1 = ActiveSheet.Shapes("СтрПрибыло")
            Set shp_2 = ActiveSheet.Shapes("ТекстПрибыло")


        'Следующий блок должен следить за изменением значения ячейки E3 листа2
        Case "E3"
            Set shp_1 = ActiveSheet.Shapes("СтрЛист2")
            Set shp_2 = ActiveSheet.Shapes("ТекстЛист2")

        Case Else
            Exit Sub
    End Select

    If IsNumeric(Target.Value) Then
        Select Case Target.Value
            Case Is > 0
                color_ = RGB(0, 176, 80)
            Case Is = 0
                color_ = RGB(0, 176, 240)
            Case Is < 0
                color_ = RGB(192, 0, 0)
        End Select

        shp_1.Fill.ForeColor.RGB = color_
        shp_2.TextFrame.Characters.Font.Color = color_
    End If
End Sub

[/vba]

К сообщению приложен файл: 12321.xlsm (30.3 Kb)

Ответить

boa

Дата: Понедельник, 24.06.2019, 10:40 | Сообщение № 2

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

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

Сообщений: 559

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

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

365

В модуль книги
[vba]

Код

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)

If Sh.Name = "Основная" Or Sh.Name = "Лист2" Then
    With Sheets("Основная")
        Select Case Sh.Name & Target.Address(0, 0)
            Case "Основная" & "H3"
                Set shp_1 = .Shapes("СтрОтправлено")
                Set shp_2 = .Shapes("ТекстОтправлено")
            Case "Основная" & "E3"
                Set shp_1 = .Shapes("СтрПрибыло")
                Set shp_2 = .Shapes("ТекстПрибыло")


            'Следующий блок должен следить за изменением значения ячейки E3 листа2
            Case "Лист2" & "E3"
                Set shp_1 = .Shapes("СтрЛист2")
                Set shp_2 = .Shapes("ТекстЛист2")

            Case Else
                Exit Sub
        End Select
    End With
    If IsNumeric(Target.Value) Then
        Select Case Target.Value
            Case Is > 0
                color_ = RGB(0, 176, 80)
            Case Is = 0
                color_ = RGB(0, 176, 240)
            Case Is < 0
                color_ = RGB(192, 0, 0)
        End Select

        shp_1.Fill.ForeColor.RGB = color_
        shp_2.TextFrame.Characters.Font.Color = color_
    End If
End If
End Sub

[/vba]

К сообщению приложен файл: 12321-2.xlsm (40.5 Kb)

Сообщение отредактировал boa - Понедельник, 24.06.2019, 10:50

Ответить

kotlovan

Дата: Понедельник, 24.06.2019, 10:46 | Сообщение № 3

Группа: Пользователи

Ранг: Новичок

Сообщений: 30

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

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

Excel 2013

boa, цвет третьего блока в приложенном файле не меняется.

Правильно понимаю, что сейчас для второго блока будет проверяться ячейка E3 на двух листах? Это неправильно. Нужно для каждой фигуры указывать конкретный лист. Для второго блока Е3 первого листа. Для третьего блока ячейка Е3 второго листа.

Ответить

_Boroda_

Дата: Понедельник, 24.06.2019, 10:51 | Сообщение № 4

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

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

Сообщений: 16718

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

Замечаний: ±

2003; 2007; 2010; 2013 RUS

Или в модуль второго листа (в модуле первого тоже поправить немного)
[vba]

Код

Sub Worksheet_Change(ByVal Target As Range)
    Select Case Target.Address(0, 0)
        Case "E3"
            Set shp_1 = Sheets("Основная").Shapes("СтрЛист2")
            Set shp_2 = Sheets("Основная").Shapes("ТекстЛист2")
        Case Else
            Exit Sub
    End Select
    If IsNumeric(Target.Value) Then
        Select Case Target.Value
            Case Is > 0
                color_ = RGB(0, 176, 80)
            Case Is = 0
                color_ = RGB(0, 176, 240)
            Case Is < 0
                color_ = RGB(192, 0, 0)
        End Select
        shp_1.Fill.ForeColor.RGB = color_
        shp_2.TextFrame.Characters.Font.Color = color_
    End If
End Sub

[/vba]

К сообщению приложен файл: 12321_.xlsm (32.1 Kb)

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