Заполните ячейки между 2 ячейками

Question

У меня есть какая-то проблема, которая сейчас перемалывает мои шестерни.Описание действительно простое.Я хотел бы «нарисовать линию клеток» между двумя клетками (которые как-то помечены).Как вы отмечаете 2 ячейки, затем нажимаете кнопку, и создается линия с заполненными ячейками между этими двумя точками.

Я до сих пор не могу понять, как заполнить каждую ячейку между этими двумя точками,У меня были некоторые математические идеи, но я не мог заставить их в коде работать должным образом.

Private Sub CommandButton1_Click()
Dim i As Integer, j As Integer, k As Integer, l As Integer

Dim cred As Long
Dim cgreen As Long
Dim startx As Integer
Dim starty As Integer
Dim endx As Integer
Dim endy As Integer
Dim koef As Single
Dim arr(1 To 20, 1 To 20) As Boolean
Dim st As Integer

cgreen = Range("X5").Interior.Color
cred = Range("X6").Interior.Color

'Start and End
For i = 1 To 20
    For j = 1 To 20
        If Cells(i, j).Interior.Color = cred Then
            endx = j
            endy = -i
        ElseIf Cells(i, j).Interior.Color = cgreen Then
            startx = j
            starty = -i
        End If
    Next j
Next i

koef = (endy - starty) / (endx - startx)
If starty < endy Then
    st = 1
Else
    st = -1
End If


For i = startx To endx
    For k = starty To endy Step st
    l = -k / koef
    j = starty + koef * (i - startx)
    l = starty + koef * (i + 1 - startx)
    If k >= j Then
    arr(i, -j) = True
    End If
    Next k
Next i

For i = 1 To 20
    For j = 1 To 20
        If arr(j, i) = True Then
            Cells(i, j).Interior.Color = RGB(255, 255, 0)
        End If
    Next j
Next i

Answer 1

Вы можете найти точки пересечения, как на изображении ( img1 ), вокруг них.Это координаты ваших ячеек, чтобы заполнить цветом. Или даже лучше: вы можете найти пересечение границ каждой ячейки ( img2 ) и поиграть со значением дроби ( img3 ), чтобы получить интенсивность пикселя. Здесьвот что достигнуто: img4