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

我有这样的工作簿：

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来遍历形状集合，并使用shpvariables引用每个形状。

 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 

最后，如果你想移动特定types的形状，你可以使用：

 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 

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

以及这里的autoshapetypes列表： https ：//msdn.microsoft.com/en-us/library/aa432469( v= office.12).aspx