Перебирайте фигуры и делайте IncrementLeft

Question

Мне нужно изменить свои фигуры, потому что все в одном месте.У фигур есть картинки, и я хочу сделать IncrementLeft, начиная с формы с именем 2, затем перейти к 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