Snasui Excel Forum

Code: Select all

Sub Action1()
Dim shp As Shape
Set shp = ActiveSheet.Shapes(Application.Caller)
With shp
.Width = .Height
.OnAction = "Action2"
[a1] = TypeName(shp) & " " & shp.Name
End With
End Sub
Sub Action2()
Dim shp As Shape
Set shp = ActiveSheet.Shapes(Application.Caller)
With shp
.Width = .Height * 2
.OnAction = "Action1"
[a1] = TypeName(shp) & " " & shp.Name
End With
End Sub

Code: Select all

Sub test0()
    Dim obj As Object, objOther As Object
    Dim objRow As Integer, point As Integer
    Set obj = ActiveSheet.Shapes(Application.Caller)
    objRow = obj.TopLeftCell.Row
    '1 is column d and 4 is column g
    point = obj.TopLeftCell.Column - 3
    For Each objOther In ActiveSheet.Shapes
        If objOther.TopLeftCell.Row = objRow Then
            If objOther.Name = obj.Name Then
                objOther.Fill.ForeColor.RGB = rgbRed
                ActiveSheet.Cells(objRow, "h").Value = point
            Else
                objOther.Fill.ForeColor.RGB = rgbWhite
            End If
        End If
    Next objOther
End Sub