Перемещение нескольких изображений с изменением идентификатора

Question

Я хотел бы сделать перемещение (вырезать и вставить) для нескольких изображений.

Идентификатор формы изменяется 1 на одно, так же, как и выделение. name name

Целевые ячейки также меняются на 1 значение, как вы можете видеть.

Мой код выглядит следующим образом:

Private Sub ChamberImage_Click()

ActiveSheet.Shapes("Textbox_Chamber1").Cut
ActiveSheet.Range("AA70").PasteSpecial
Selection.Name = "Textbox_Chamber1"

ActiveSheet.Shapes("Textbox_Chamber2").Cut
ActiveSheet.Range("AA71").PasteSpecial
Selection.Name = "Textbox_Chamber2"

ActiveSheet.Shapes("Textbox_Chamber3").Cut
ActiveSheet.Range("AA72").PasteSpecial
Selection.Name = "Textbox_Chamber3"

ActiveSheet.Shapes("Textbox_Chamber4").Cut
ActiveSheet.Range("AA73").PasteSpecial
Selection.Name = "Textbox_Chamber4"

ActiveSheet.Shapes("Textbox_Chamber5").Cut
ActiveSheet.Range("AA74").PasteSpecial
Selection.Name = "Textbox_Chamber5"

ActiveSheet.Shapes("Textbox_Chamber6").Cut
ActiveSheet.Range("AA75").PasteSpecial
Selection.Name = "Textbox_Chamber6"

ActiveSheet.Shapes("Textbox_Chamber7").Cut
ActiveSheet.Range("AA76").PasteSpecial
Selection.Name = "Textbox_Chamber7"

ActiveSheet.Shapes("Textbox_Chamber8").Cut
ActiveSheet.Range("AA77").PasteSpecial
Selection.Name = "Textbox_Chamber8"

ActiveSheet.Shapes("Textbox_Chamber9").Cut
ActiveSheet.Range("AA78").PasteSpecial
Selection.Name = "Textbox_Chamber9"

End Sub

Как я могу написать его намного умнее ? Это какой-то л oop на нем?

Answer 1

Без нарезки / пасты:

Private Sub ChamberImage_Click()

    Dim i as long , shp, ws as worksheet

    set ws = activesheet

    For i = 1 to 9

        set shp = ws.Shapes("Textbox_Chamber" & i)

        with ws.Range("AA70").Offset(i - 1 , 0)
            shp.top = .Top
            shp.left = .Left
        end with

    Nexti

End Sub