我想复制一个形状并将其粘贴到一个已经包含一个或多个形状的工作表中。我尝试使用以下简单代码:
myShape.Select
Selection.Copy
ActiveWorkbook.Sheets(mySheet).Paste
但它会将其粘贴在工作表中现有形状的上方......
是否有解决方案来检测现有形状的结尾或直接粘贴在之后?谢谢
我想复制一个形状并将其粘贴到一个已经包含一个或多个形状的工作表中。我尝试使用以下简单代码:
myShape.Select
Selection.Copy
ActiveWorkbook.Sheets(mySheet).Paste
但它会将其粘贴在工作表中现有形状的上方......
是否有解决方案来检测现有形状的结尾或直接粘贴在之后?谢谢
这是你正在尝试的吗?
Sub Sample()
Dim myShape As Shape
Set myShape = ActiveSheet.Shapes("Rectangle 1")
myShape.Copy
ActiveSheet.Paste
With Selection
.Top = myShape.Height + 10
.Left = myShape.Left
End With
End Sub
如果有更多形状,那么您将不得不遍历所有形状,然后找到最后一个形状并考虑该.Top形状.Height。
看这个例子
Option Explicit
Sub Sample()
Dim myShape As Shape, shp As Shape
Dim sHeight As Double, sTopp As Double
For Each shp In ActiveSheet.Shapes
If shp.Top > sTopp Then
sTopp = shp.Top
sHeight = shp.Height
End If
Next
Set myShape = ActiveSheet.Shapes("Rectangle 1")
myShape.Copy
ActiveSheet.Paste
With Selection
.Top = sTopp + sHeight + 10
.Left = myShape.Left
End With
End Sub