2

シェイプをコピーして、既に 1 つ以上のシェイプを含むシートに貼り付けたいと考えています。次の簡単なコードを使用してみました:

myShape.Select
Selection.Copy
ActiveWorkbook.Sheets(mySheet).Paste

しかし、シート内の既存の形状の上に貼り付けます...

既存の形状の終わりを検出するか、直後に貼り付ける解決策はありますか? どうも

4

1 に答える 1

6

これはあなたがしようとしていることですか?

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
于 2012-04-20T10:12:35.970 に答える