I have the following code that will increase the size of a shape when it's clicked, and decreases it to its original size on the second click.
Sub Picture2_Click()
Dim shp As Shape
Dim big As Single, small As Single
Dim shpDouH As Double, shpDouOriH As Double
big = 2
small = 0.5
On Error Resume Next
Set shp = ActiveSheet.Shapes(Application.Caller)
With shp
shpDouH = .Height
.ScaleHeight 1, msoTrue, msoScaleFromTopLeft
shpDouOriH = .Height
If Round(shpDouH / shpDouOriH, 2) = big Then
.ScaleHeight small, msoTrue, msoScaleFromTopLeft
.ScaleWidth small, msoTrue, msoScaleFromTopLeft
.ZOrder msoSendToBack
Else
.ScaleHeight big, msoTrue, msoScaleFromTopLeft
.ScaleWidth big, msoTrue, msoScaleFromTopLeft
.ZOrder msoBringToFront
End If
End With
End Sub
What I would like it to do is to display the shape with the top left corner positioned in cell A1 when the size is increased, and return it to its original position when the size is decreased.
Can anyone help?
Thanks in advance
Sub Picture2_Click()
Dim shp As Shape
Dim big As Single, small As Single
Dim shpDouH As Double, shpDouOriH As Double
big = 2
small = 0.5
On Error Resume Next
Set shp = ActiveSheet.Shapes(Application.Caller)
With shp
shpDouH = .Height
.ScaleHeight 1, msoTrue, msoScaleFromTopLeft
shpDouOriH = .Height
If Round(shpDouH / shpDouOriH, 2) = big Then
.ScaleHeight small, msoTrue, msoScaleFromTopLeft
.ScaleWidth small, msoTrue, msoScaleFromTopLeft
.ZOrder msoSendToBack
Else
.ScaleHeight big, msoTrue, msoScaleFromTopLeft
.ScaleWidth big, msoTrue, msoScaleFromTopLeft
.ZOrder msoBringToFront
End If
End With
End Sub
What I would like it to do is to display the shape with the top left corner positioned in cell A1 when the size is increased, and return it to its original position when the size is decreased.
Can anyone help?
Thanks in advance