更改ID更改的多个图像的重定位 [英] Relocation of multiple images with ID changing

问题描述

我想对很多图像进行重定位(剪切和粘贴).

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

形状ID随选择变化1一次.名称值

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

目标单元格也会改变1个值，如您所见.

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

我的代码如下:

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?

推荐答案

没有剪切/粘贴:

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

这篇关于更改ID更改的多个图像的重定位的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！