すべてのシートの同じ位置にデータの有無で複数のセル上に１本の斜線を引きたい

初めて質問させていただきます。
ＶＢＡは初心者です。
データの有無で下の余白に自動で斜線を引きたいと思っています。
ネットで色々調べて個別に斜線を作成・削除のマクロ（＊）はなんとか作ってはみたのですが、
自動で斜線作成・削除には至っていません。
SheetChangeイベントを利用するとは思うのですが、
そこから先どうすればいいのか全くわかりません。
お手上げです。
どなたかご教授いただけないでしょうか？
Excel2016を使用しています。
何卒宜しくお願い致します。

↓乱文ですみません。

シート1ページ目と以降の他のシートは全く同じ内容で、
1ページ目に入力をすると他のページにも反映されるように式を入れています。

シート1ページ目のQ34：U34(①)、V34:Z34(②)、AA34:AE34(③)は結合セルで、
入力規制でデータをそれぞれ選べるようになっています。

①、②、③にデータがない（入力規制で選ばずブランク）場合、
①はその下のQ35:U66、②はV35:Z66、③はAA35:AE66に
添付画像のように右下がりの斜線を引いて、これを他のすべてのシートの同じ位置にも斜線を引きたいです。（①、②、③は③だけデータがなかったり、②・③だけデータがなかったりします。）

＊以下はQ35：U34で斜線を入れた時と削除したときのマクロを
　わからないなりに調べて作ってみました。。。
ーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーー
Sub 斜線作成①()

Dim i As Long

For i = 2 To Worksheets.Count

Worksheets(1).Shapes.AddLine(Range("Q35").Left, Range("Q35").Top, Range("V67").Left, Range("V67").Top).Select

Selection.Copy
Sheets(i).Select
Range("Q35:U36").Select
Sheets(i).Paste

Next
End Sub
ーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーー
Sub 斜線削除①()

Dim j As Long
Dim r As Range
Dim o As Object

For j = 1 To Worksheets.Count
For Each o In Worksheets(i).DrawingObjects

Sheets(j).Select
Range("Q35:U66").Select
Set r = Range("Q35:U36")
If Not Intersect(o.TopLeftCell, Worksheets(j).Range("Q35:U36")) Is Nothing Then
o.Delete
End If

Next
Next
End Sub

No.3 ベストアンサー 回答者： GooUserラック 回答日時： 2019/10/17 21:51

No.1 No.2 の補足

今まで既にひかれている斜線は削除しませんので事前に斜線は削除しておいてください。
なぜかと言うとシェイプにシート名などを含んだ名前を付けてそれを使っているので、既に引かれている物は名前がマッチしないので削除できません。

No.2 回答者： GooUserラック 回答日時： 2019/10/17 21:24

No.1 の修正です。

「斜線作成」の中で「斜線削除」を呼び出すようにしました。

Sub 斜線作成(シート名 As String, 左上行番号 As Long, 左上列番号 As Long, 右下行番号 As Long, 右下列番号 As Long)

　Dim 左 As Long
　Dim 上 As Long
　Dim 右 As Long
　Dim 下 As Long
　Dim シェイプ As Object
　Dim シェイプ名 As String
　Dim 有 As Boolean
　
　　Call 斜線削除(シート名, 左上行番号, 左上列番号, 右下行番号, 右下列番号)
　　左 = Sheets(シート名).Columns(左上列番号).Left
　　上 = Sheets(シート名).Rows(左上行番号).Top
　　右 = Sheets(シート名).Columns(右下列番号 + 1).Left
　　下 = Sheets(シート名).Rows(右下行番号 + 1).Top
　　シェイプ名 = シート名 & ":" & 左上行番号 & ":" & 左上列番号 & ":" & 右下行番号 & ":" & 右下列番号
　　Sheets(シート名).Shapes.AddLine(左, 上, 右, 下).Name = シェイプ名

End Sub

No.1 回答者： GooUserラック 回答日時： 2019/10/17 21:12

以下のようなものはいかがですか？

「斜線作成」と「斜線削除」は汎用性の高い物を作りました。
変数を日本語にしたので大体わかると思いますが判らないときは聞いて下さい。
「斜線作成」では同じ名前のシェイプが存在した時はそれを削除してから新たに作っています。

ーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーー
Sub Sample()

　Dim シート As Worksheet
　Dim 列番号 As Long
　
　　For Each シート In Worksheets
　　　For 列番号 = 17 To 27 Step 5
　　　　If シート.Cells(34, 列番号).Value = "" Then
　　　　　Call 斜線作成(シート.Name, 35, 列番号, 66, 列番号 + 4)
　　　　Else
　　　　　Call 斜線削除(シート.Name, 35, 列番号, 66, 列番号 + 4)
　　　　End If
　　　Next
　　Next

End Sub
ーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーー
Sub 斜線作成(シート名 As String, 左上行番号 As Long, 左上列番号 As Long, 右下行番号 As Long, 右下列番号 As Long)

　Dim 左 As Long
　Dim 上 As Long
　Dim 右 As Long
　Dim 下 As Long
　Dim シェイプ As Object
　Dim シェイプ名 As String
　Dim 有 As Boolean

　　左 = Sheets(シート名).Columns(左上列番号).Left
　　上 = Sheets(シート名).Rows(左上行番号).Top
　　右 = Sheets(シート名).Columns(右下列番号 + 1).Left
　　下 = Sheets(シート名).Rows(右下行番号 + 1).Top
　　シェイプ名 = シート名 & ":" & 左上行番号 & ":" & 左上列番号 & ":" & 右下行番号 & ":" & 右下列番号
　　For Each シェイプ In Sheets(シート名).DrawingObjects
　　　If シェイプ.Name = シェイプ名 Then
　　　　シェイプ.Delete
　　　End If
　　Next
　　Sheets(シート名).Shapes.AddLine(左, 上, 右, 下).Name = シェイプ名

End Sub
ーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーーー
Sub 斜線削除(シート名 As String, 左上行番号 As Long, 左上列番号 As Long, 右下行番号 As Long, 右下列番号 As Long)

　Dim シェイプ As Object
　Dim シェイプ名 As String
　　
　　シェイプ名 = シート名 & ":" & 左上行番号 & ":" & 左上列番号 & ":" & 右下行番号 & ":" & 右下列番号
　　For Each シェイプ In Sheets(シート名).DrawingObjects
　　　If シェイプ.Name = シェイプ名 Then
　　　　シェイプ.Delete
　　　End If
　　Next

End Sub