循环遍历形状并执行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

截图

Answer 2

你需要使用前一个shp的位置作为下一个的原点。

尝试这样的事情：

Dim Origin As Single

Dim shp As Shape
For Each shp In ActiveSheet.Shapes
    If shp.AutoShapeType = msoShapeRectangle Then
        If Val(shp.Name) > 1 Then
           shp.IncrementLeft Origin + 146
           Origin = shp.Left 'depending on what you want it might be shp.Left + shp.Width here
        End If
    End If
Next shp