Question

最近，在一次采访中，我在VBA遇到了一个问题。问题是：

编写一个程序来对工作表中的形状进行排序，例如：我有各种形状，如圆形，三角形，矩形，五边形......这需要排序并放在另一个之下。我尝试使用Shapes对象和msoshapeRectangle方法。但它没有用。

你能告诉我这可能吗？

由于

Answer 1

这是一个有趣的挑战，所以我做到了。不妨发布结果（为了清晰起见）：

Sub tgr()

    'There are 184 total AutoShapeTypes
    'See here for full list
    'https://msdn.microsoft.com/VBA/Office-Shared-VBA/articles/msoautoshapetype-enumeration-office
    Dim aShapeTypes(1 To 184) As String

    Dim ws As Worksheet
    Dim Shp As Shape
    Dim i As Long, j As Long
    Dim vShpName As Variant
    Dim dLeftAlign As Double
    Dim dTopAlign As Double
    Dim dVerticalInterval As Double
    Dim dHorizontalInterval As Double
    Dim dPadding As Double

    Set ws = ActiveWorkbook.ActiveSheet

    'Sort order will be by the AutoShapeType numerical ID
    'Using this, shapes will be sorted in this order (incomplete list for brevity):
    '   Rectangle, Parallelogram, Trapezoid, Diamond, Rounded rectangle, Octagon, Isosceles triangle, Right triangle, Oval, Hexagon
    'Note that you can use a Select Case to order shapes to a more customized list
    'I use this method to put the -2 (indicates a combination of the other states) at the bottom of the sort order
    For Each Shp In ws.Shapes
        Select Case Shp.AutoShapeType
            Case -2:    aShapeTypes(UBound(aShapeTypes)) = aShapeTypes(UBound(aShapeTypes)) & "||" & Shp.Name
            Case Else:  aShapeTypes(Shp.AutoShapeType) = aShapeTypes(Shp.AutoShapeType) & "||" & Shp.Name
        End Select
    Next Shp

    'Now that all shapes have been collected and put into their sort order, perform the actual sort operation
    'Adjust the alignment and vertical veriables as desired
    'The Padding variable is so that the shapes don't start at the very edge of the sheet (can bet set to 0 if that's fine)
    'I have it currently set to sort the shapes vertically, but they can be sorted horizontally by uncommenting those lines and commenting out the vertical sort lines

    dPadding = 10
    dLeftAlign = 5
    dTopAlign = 5
    dVerticalInterval = 40
    dHorizontalInterval = 40

    j = 0
    For i = LBound(aShapeTypes) To UBound(aShapeTypes)
        If Len(aShapeTypes(i)) > 0 Then
            For Each vShpName In Split(Mid(aShapeTypes(i), 3), "||")
                With ws.Shapes(vShpName)

                    'Vertical Sort
                    .Left = dLeftAlign
                    .Top = j * dVerticalInterval + dPadding

                    'Horizont Sort
                    '.Top = dTopAlign
                    '.Left = j * dHorizontalInterval + dPadding

                End With
                j = j + 1
            Next vShpName
        End If
    Next i

End Sub

VBA：需要对形状

1 个答案: