CODEWITHSUNDEEP
excelvba
DDV
DDV

Reputation: 2395

Moving a Shape in a Workbook

I want to move a shape when a user selects Yes or No from a dropdown list. I thought this would be simple, namely cut & paste the shape using VBA, but it does not seem to work that way.

Below image as a visual representation:

enter image description here

The objective is to bring the shape into view (cell CC18) when selected yes, and out of view (ideally on another sheet, but can also move to the same sheet) when select no.

I ran the Macro Recorder and got the below code:

Sub Macro1()
'
' Macro1 Macro
'

'
    ActiveSheet.Shapes.Range(Array("shpAPEX")).Select
    Selection.Cut
    Range("CH18").Select
    ActiveSheet.Paste
End Sub

Obviously this is not ideal, so I tried to translate that into something cleaner, namely:

ws.Shapes("shpAPEX").Cut
ws.Range("CC18").Paste

But this does not work. It cuts the shape, but does not paste it. I can see this by finding the shape in the clipboard.

However, the below code works:

ws.Shapes("shpAPEX").Cut
ws.Range("CC18").Select
ActiveSheet.Paste

Can anyone please explain to me why my initial attempt does not work, and also what is the best way to move shapes between worksheets?

Upvotes: 0

Views: 530

Answers (1)

SJR
SJR

Reputation: 23081

The easiest way is to change the shape's visible property:

Private Sub Worksheet_Change(ByVal Target As Range)

If Target.Address(0, 0) = "A1" Then
    ActiveSheet.Shapes("Rectangle 1").Visible = (Target.Value = "Yes")
End If

End Sub

However, if that is not desirable or a problem, you could keep the shape on another sheet and then just copy it to sheet1 or delete. This might need some adjustment if you have other shapes on the sheet, and error trapping in case there is no shape when trying to delete:

Private Sub Worksheet_Change(ByVal Target As Range)

Dim s As Shape

Set s = Sheet2.Shapes("Rectangle 1") 'shape on another sheet

If Target.Address(0, 0) = "A1" Then
    If Target.Value = "Yes" Then
        s.Copy
        ActiveSheet.Paste 'then use top/left etc to position
    Else
        ActiveSheet.Shapes(1).Delete
    End If
End If

End Sub

Upvotes: 1

Related Questions