シェイプをコピーして、既に 1 つ以上のシェイプを含むシートに貼り付けたいと考えています。次の簡単なコードを使用してみました:
myShape.Select
Selection.Copy
ActiveWorkbook.Sheets(mySheet).Paste
しかし、シート内の既存の形状の上に貼り付けます...
既存の形状の終わりを検出するか、直後に貼り付ける解決策はありますか? どうも
シェイプをコピーして、既に 1 つ以上のシェイプを含むシートに貼り付けたいと考えています。次の簡単なコードを使用してみました:
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