Перемещение фигуры в рабочей книге

Question

Я хочу переместить фигуру, когда пользователь выбирает Да или Нет из раскрывающегося списка. Я думал, что это будет просто, а именно, вырезать и вставлять фигуру с помощью VBA, но, похоже, это не сработает.

Ниже изображение в качестве визуального представления:

Цель состоит в том, чтобы отобразить форму (ячейка CC18), если выбрано «да», и вне поля зрения (в идеале, на другом листе, но также можно перейти на тот же лист), если выбрано «нет».

Я запустил Macro Recorder и получил следующий код:

Sub Macro1()
'
' Macro1 Macro
'

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

Очевидно, что это не идеально, поэтому я попытался перевести это в нечто более чистое, а именно:

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

Но это не работает. Это сокращает форму, но не вставляет это. Я могу видеть это, находя форму в буфере обмена.

Однако работает приведенный ниже код:

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

Может кто-нибудь объяснить мне, почему моя первоначальная попытка не работает, а также как лучше всего перемещать фигуры между листами?

Answer 1

Самый простой способ - изменить свойство visible формы:

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

Однако, если это нежелательно или является проблемой, вы можете сохранить форму на другом листе, а затем просто скопировать ее в лист1 или удали. Это может потребовать некоторой корректировки, если у вас есть другие фигуры на листе, и перехват ошибок, если при попытке удаления фигуры нет:

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