Как я могу получить группу фигур для изменения цвета в зависимости от того, какой был выбран? - PullRequest
0 голосов
/ 07 февраля 2020

У меня есть 4 фигуры в группе: «Клиент, Продавец, Перспектива, Подозреваемый». Я хочу иметь возможность выбрать одну фигуру, чтобы изменить стиль, но только один из них должен быть этим стилем за раз. Поэтому, если CustomerStyle - это msoShapeStyle31, тогда я хочу, чтобы все остальные 3 были msoShapeStyle32; но если пользователь нажимает на одну из 3 других кнопок, эта кнопка должна измениться на msoShapeStyle31, а остальные 3 преобразуются в msoShapeStyle32. Я надеюсь, что в этом есть смысл.

RelationshipButtons - это группа, которую я планирую вывести на экран значения ячейки, в зависимости от того, какой из форм является msoShapeStyle31.

Вот то, что у меня есть, но это неправильно, потому что несколько из них обращаются к msoShapeStyle31 в то же время, когда он должен быть только один за один раз. Любая помощь?

Sub Button_Colors()
With Sheet1

Dim CustomerButton As Shape, VendorButton As Shape, ProspectButton As Shape, SuspectButton As Shape, RelationshipButtons As Shape
Set CustomerButton = .Shapes("CustomerButton")
Set VendorButton = .Shapes("VendorButton")
Set ProspectButton = .Shapes("ProspectButton")
Set SuspectButton = .Shapes("SuspectButton")
Set RelationshipButtons = .Shapes("RelationshipButtons")

Dim CustomerStyle As Integer, VendorStyle As Integer, ProspectStyle As Integer, SuspectStyle As Integer
CustomerStyle = CustomerButton.ShapeStyle
VendorStyle = VendorButton.ShapeStyle
ProspectStyle = ProspectButton.ShapeStyle
SuspectStyle = SuspectButton.ShapeStyle

With RelationshipButtons
    If CustomerStyle = 31 Then
        CustomerStyle = msoShapeStylePreset32
        VendorStyle = msoShapeStylePreset31
        ProspectStyle = msoShapeStylePreset31
        SuspectStyle = msoShapeStylePreset31
    ElseIf VendorStyle = 31 Then
        CustomerStyle = msoShapeStylePreset31
        VendorStyle = msoShapeStylePreset32
        ProspectStyle = msoShapeStylePreset31
        SuspectStyle = msoShapeStylePreset31
    ElseIf ProspectStyle = 31 Then
        CustomerStyle = msoShapeStylePreset31
        VendorStyle = msoShapeStylePreset31
        ProspectStyle = msoShapeStylePreset32
        SuspectStyle = msoShapeStylePreset31
    ElseIf SuspectStyle = 31 Then
        CustomerStyle = msoShapeStylePreset31
        VendorStyle = msoShapeStylePreset31
        ProspectStyle = msoShapeStylePreset31
        SuspectStyle = msoShapeStylePreset32
    End If
End With
    CustomerButton.ShapeStyle = CustomerStyle
    VendorButton.ShapeStyle = VendorStyle
    ProspectButton.ShapeStyle = ProspectStyle
    SuspectButton.ShapeStyle = SuspectStyle
End With
End Sub

Ответы [ 2 ]

2 голосов
/ 07 февраля 2020

Вот один подход, который немного более лаконичен:

'all the shpes in the group "Group 6" are assigned this macro
Sub ToggleShapes()
    Dim shp As Shape, clr
    clr = Application.Caller  '<< this is the name of the clicked shape
    Debug.Print clr
    'loop over the grouped shapes and set the color according to their name
    For Each shp In ActiveSheet.Shapes("Group 6").GroupItems
        shp.Fill.ForeColor.RGB = IIf(shp.Name = clr, vbRed, vbYellow)
    Next shp
End Sub
1 голос
/ 07 февраля 2020

Весь кредит должен go @Tim Williams! Я просто адаптировал его код, чтобы точно выполнять то, что (я понял) Мишель нуждается. Похоже, что Мишель только сейчас поняла разницу между формой и кнопкой, и у меня есть некоторые сомнения, что ей удастся адаптировать этот прекрасный код Тима так, как она начала.

Как сказал Тим Уильямс, вы должны назначьте этот макрос для всех задействованных фигур. Макрос должен существовать в модуле. Код не проверяет, являются ли имена прямоугольников теми, которые вы опубликовали. Предполагается (в этом варианте), что они ...

Sub ToggleShapes()
    Dim clr As String, arrNames As Variant, El As Variant
    arrNames = Array("CustomerButton", "VendorButton", "ProspectButton", "SuspectButton")
    clr = Application.Caller
        For Each El In arrNames
            If ActiveSheet.Shapes(El).Name = clr Then
                ActiveSheet.Shapes(El).ShapeStyle = msoShapeStylePreset32
                'do something else if the case...
            Else
                ActiveSheet.Shapes(El).ShapeStyle = msoShapeStylePreset31
            End If
        Next
End Sub

Я также предположил, что единственная цель кода - не только окрашивать фон. Я думал, что, кроме того, он должен что-то делать ...

Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...