仕事の書類を作成するに当たり、必要となったので作成。
chatGPTでは一発でうまく作成できなかったので、備忘録として。

Sub 選択範囲に斜線を入れる()
    Dim HT, TP, LF, WD, DN As Double
    Dim startCell, endCell As Range
    Dim drawingShape As Shape
   
    With Selection
        ' 選択範囲の開始セルと終了セルを取得
        Set startCell = .Cells(1, 1)
        Set endCell = .Cells(Selection.Rows.Count, Selection.Columns.Count)
       
        WD = .Width
        HT = .Height
        LF = startCell.Left
        DN = startCell.Top + (endCell.Top - startCell.Top + endCell.Height)
   
    End With
   
    Set drawingShape = ActiveSheet.Shapes.AddConnector(msoShapeRectangle, LF, DN, LF + WD, DN - HT)
    drawingShape.line.ForeColor.RGB = RGB(0, 0, 0)

End Sub

こんな感じになります。

参考