大名シェイプ 

シェイプを貼付したとき、値があれば行を挿入する

シェイプが大名が如く、行たちが道を開けるから「大名シェイプ」。
この関数内でペースト処理もしてるから[Ctrl + V]は不要でいきなりホットキーを使うと、貼り付けと同時に行を開けてくれる。
まだ応用の余地があると思う。折を見てチャレンジ。

'#シェイプの場所に値がなくなるように空行を挿入する
Sub insertBlankRowForShape()
    '#クリップボードにデータがある時のみ
    If Application.ClipboardFormats(1) Then
        ActiveSheet.Paste
        '移動位置を取得するためのダミーシェイプ
        Dim dummyShape As Shape
        '左下隅のセルを取得するためのダミーシェイプ
        Set dummyShape = ActiveSheet.Shapes.AddShape(msoShapeRectangle, _
                                                        Selection.Left, _
                                                        Selection.Top + Selection.Height, 1, 1)
    
        '開発用
'        Debug.Print "選択中シェイプの大きさ:" & Selection.Height
'        Debug.Print "シェイプの左上セル:" & Selection.TopLeftCell.Address
'        Debug.Print "シェイプの左下セル:" & dummyShape.TopLeftCell.Address
    
        '「セルに合わせて移動やサイズ変更をしない」に設定
        'これやらないと行の挿入に合わせてシェイプも一緒に伸びてしまうから
        Selection.Placement = xlFreeFloating
    
        For i = Selection.TopLeftCell.Row To dummyShape.TopLeftCell.Row
            If Cells(i, Selection.TopLeftCell.Column) <> "" Then
                Rows(i).Insert
'                Debug.Print i & "行目に挿入しました。"
            End If
        Next
    
        '用済みだから削除する
        dummyShape.delete
    End If
End Sub


コメント