Question

我在B列的每个单元格中有多个图像。有1000行。

我需要一个VBA到＆＃34;自动组＆＃34;每行可用的图片。但是使用下面的代码我不能一次在单个单元格中执行操作。

Sub groupimagesandshape()
' group images and shapes in each cell of column B

Sheet1.Shapes.SelectAll
Selection.Group

ActiveWorkbook.Save

End Sub

Answer 1

形状在B列的单元格中，然后此代码将起作用。

Sub test()
    Dim shp As Shape, shpU As Shape
    Dim vArray(), vR()
    Dim Ws As Worksheet, rng As Range
    Dim n  As Long, k As Integer
    Dim v As Variant

    Set Ws = ActiveSheet

    Ws.Shapes.SelectAll
    Selection.Ungroup

    For Each shp In Ws.Shapes
        n = n + 1
        ReDim Preserve vArray(1 To n)
        vArray(n) = shp.Name
    Next shp
    For Each rng In Ws.Range("b1:b1000")
        k = 0
        For Each v In vArray
            If Not Intersect(Ws.Shapes(v).TopLeftCell, rng) Is Nothing Then
                k = k + 1
                ReDim Preserve vR(1 To k)
                vR(k) = v
            End If
        Next v
        If k > 1 Then
            Ws.Shapes.Range(vR).Group
        End If
    Next rng
End Sub

VBA：每个excel单元格中保存的自动组多图片

1 个答案: