選択範囲を黒枠透明の長方形で囲む【素人 Word マクロ】

Microsoft officeのWordVBAでマクロを組みましたので公開します。
インターネットで検索したり、マクロの記録機能を使ったり、AIに考えてもらったりしたのを組み合わせだけなので、上手くはないですが、一応動くはずです。
office2021です。
必ず、元データのバックアップを取ってから実行してください。
素人の作ったものなので、信用しすぎないでください。

▶こちらのほうがいいかもしれません。

［仕様］
選択範囲に合わせて、長方形を挿入します。
横幅はだいたい大丈夫ですが、高さはページ設定によって変わるので、自分で調節してください。

［コード］

Sub 囲み図形を挿入()

    Dim selRange As Range
    Dim shp As Shape
    Dim selLeft As Single
    Dim selTop As Single
    Dim selWidth As Single
    Dim selHeight As Single
    Dim linesCount As Integer
    Dim pageWidth As Single
    Dim pageHeight As Single
    Dim leftMargin As Single
    Dim rightMargin As Single
    Dim topMargin As Single
    Dim bottomMargin As Single
    Dim correctionFactor As Single
    
    ' ドキュメントのページ設定を取得
    With ActiveDocument.PageSetup
        leftMargin = .leftMargin
        rightMargin = .rightMargin
        topMargin = .topMargin
        bottomMargin = .bottomMargin
        pageWidth = .pageWidth - leftMargin - rightMargin
        pageHeight = .pageHeight - topMargin - bottomMargin
    End With
    
    ' 選択された範囲を取得
    Set selRange = Selection.Range
    
    ' 選択範囲の位置を取得
    selLeft = selRange.Information(wdHorizontalPositionRelativeToPage)
    selTop = selRange.Information(wdVerticalPositionRelativeToPage)
    
    ' 長方形の幅を計算（余白でない部分の横幅）
    selWidth = pageWidth
    
    ' 選択範囲の行数を取得
    linesCount = selRange.ComputeStatistics(wdStatisticLines)
    
    ' 長方形の高さを計算（余白でない部分の縦幅の40分の1×選択した範囲の行の数）
    selHeight = (pageHeight / 40) * linesCount
    
    ' 補正因子を設定
    correctionFactor = 5
    
    ' 長方形の図形を挿入（左上位置を補正）
    Set shp = ActiveDocument.Shapes.AddShape(msoShapeRectangle, selLeft - correctionFactor, selTop - correctionFactor, selWidth + correctionFactor * 2, selHeight + correctionFactor * 2)
    
    ' 図形の枠線を黒、塗りつぶしをなしに設定
    shp.Line.ForeColor.RGB = RGB(0, 0, 0)
    shp.Fill.Transparency = 1
    
    ' 図形をテキストと同じ位置に移動
    shp.WrapFormat.Type = wdWrapNone

End Sub