CODEWITHSUNDEEP
excelvba
Geographos
Geographos

Reputation: 1456

Relocation of multiple images with ID changing

I would like to make a relocation (cut & paste) for quite a few images.

The Shape ID changes 1 by one, the same as the Selection. name value

The target cells also change by 1 value, as you can see.

My code looks as follows:

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

How can I write it much smarter? Is it some loop on it?

Upvotes: 0

Views: 62

Answers (1)

Tim Williams
Tim Williams

Reputation: 166146

Without the cut/paste:

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

Upvotes: 1

Related Questions