excel - 循环遍历形状并执行 IncrementLeft

Question

我需要重新定位我的形状，因为所有形状都在一个地方。形状中有图片，我想从名称为 2 的形状开始执行 IncrementLeft 操作，然后转到 3 和最后一个。下一个形状必须从前一个形状(而不是第一个形状)IncrementLeft 开始，因此我将所有形状排成一行且距离相同。

这是我的代码的一部分，它根据形状 1 移动所有形状:

For Each shp In ActiveSheet.Shapes
    If shp.AutoShapeType = msoShapeRectangle Then
        If shp.Name > "1" Then
           shp.IncrementLeft 146
        End If
    End If
Next shp

有什么建议吗？

Answer 1

shp.IncrementLeft 146 是一个坏主意。如果调整形状的宽度，则可能会导致不良结果。

根据我在您的问题下面的评论，

New position of shape = Left of old shape + Width of old shape + Margin space

这就是你正在尝试的吗？

Option Explicit

Sub Sample()
    Dim shp As Shape
    Dim ws As Worksheet
    Dim lstShp As Integer
    Dim shpLft As Double, shpTop As Double, shpWidth As Double
    Dim inBetweenMargin As Double
    Dim i As Long

    '~~> In betwen margin
    inBetweenMargin = 25 '~~> 146????

    '~~> Set this to the respective sheet
    Set ws = Sheet2

    With ws
        '~~> Get the max shape number(name)
        For Each shp In .Shapes
            If shp.AutoShapeType = msoShapeRectangle Then
                If Val(shp.Name) > 1 And Val(shp.Name) > lstShp Then _
                lstShp = Val(shp.Name)
            End If
        Next

        '~~> Loop through the shapes
        For i = 1 To lstShp
            '~~> This is required in case you delete shape 3
            '~~> and have only shapes 1,2,4,5 etc...
            On Error Resume Next
            Set shp = .Shapes(Cstr(i))
            On Error GoTo 0

            '~~> position them
            If Not shp Is Nothing Then
                If shpLft = 0 And shpTop = 0 And shpWidth = 0 Then
                    shpLft = shp.Left
                    shpTop = shp.Top
                    shpWidth = shp.Width
                Else
                    shp.Top = shpTop
                    shp.Left = shpLft + shpWidth + inBetweenMargin

                    shpLft = shp.Left
                    shpWidth = shp.Width
                End If
            End If
        Next i
    End With
End Sub

屏幕截图