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

遍历形状并执行IncrementLeft

2 个答案: