Question

我有一个像这样的工作簿：

     Column L

L5 = Image
L6 = Image
L7 = Image
L8 = Image

L列将图像复制并粘贴到每个单元格中。如果我是诚实的，那些图像看起来都有点不匹配。

我想准确地将每个图像都放到单元格中。有没有办法为列中的所有图像执行此操作，而无需定义每个图像的名称？

这是我尝试过的：

Sub FitImageToCell()
    With Sheet1.Shapes
        .Left = .TopLeftCell.Left
        .Top = .TopLeftCell.Top
        .Height = .TopLeftCell.Height
        .Width = .TopLeftCell.Width
    End With
End Sub

但我得到一个对象不支持此属性或方法错误。

有人可以告诉我该怎么做吗？

Answer 1

你快到了。
您只是错过了告诉它您正在使用的形状集合中的形状，并告诉它通过工作表上的每个形状。

此代码将使用For Each....Next循环遍历形状集合，并使用shp变量引用每个形状。

Sub FitImageToCell()

    Dim shp As Shape

    For Each shp In Sheet1.Shapes
        With shp
            .Left = .TopLeftCell.Left
            .Top = .TopLeftCell.Top
            .Height = .TopLeftCell.Height
            .Width = .TopLeftCell.Width
        End With
    Next shp

End Sub

如果您只想移动一个形状，则可以使用：

Sub FitImageToCell1()

    With Sheet1.Shapes("Rectangle 1")
        .Left = .TopLeftCell.Left
        .Top = .TopLeftCell.Top
        .Height = .TopLeftCell.Height
        .Width = .TopLeftCell.Width
    End With

End Sub

最后，如果您想移动特定类型的形状，可以使用：

Sub FitImageToCell()

    Dim shp As Shape

    For Each shp In Sheet1.Shapes
        With shp
            If .Type = msoAutoShape Then
                If .AutoShapeType = msoShapeRectangle Then
                    .Left = .TopLeftCell.Left
                    .Top = .TopLeftCell.Top
                    .Height = .TopLeftCell.Height
                    .Width = .TopLeftCell.Width
                End If
            End If
        End With
    Next shp

End Sub

这里有一个形状类型列表：https://msdn.microsoft.com/en-us/library/aa432678(v=office.12).aspx

这里有一个自动形状类型列表：https://msdn.microsoft.com/en-us/library/aa432469(v=office.12).aspx

VBA是否将列中的所有形状都适合相应的单元格？

1 个答案: