Sub ЕщёМакрос()
Dim X1#, Y1#, X2#, Y2#
Dim X1_II#, Y1_II#, X2_II#, Y2_II#
Dim dlina#, dlin_#

dlina = 200
smeshX = Cells(1, 1).Width 'Смещение параллельной линии по Х
smeshY = Cells(1, 1).Height 'Смещение параллельной линии по Y
X1 = Cells(5, 6)
Y1 = Cells(6, 5)
X2 = Cells(5, 10)
Y2 = Cells(6, 9)
dlin_ = Sqr((X1 - X2) ^ 2 + (Y1 - Y2) ^ 2)
X1_II = X1 + smeshX
Y1_II = Y1 + smeshY
X2_II = ((X2 - X1) * dlina / dlin_) + X1 + smeshX
Y2_II = ((Y2 - Y1) * dlina / dlin_) + Y1 + smeshY

Set lineA = ActiveSheet.Shapes.AddLine(X1, Y1, X2, Y2).Line
Set lineB = ActiveSheet.Shapes.AddLine(X1_II, Y1_II, X2_II, Y2_II).Line
lineB.DashStyle = msoLineDash 'msoLineDashDotDot

lineA.ForeColor.RGB = RGB(0, 0, 255)
lineB.ForeColor.RGB = RGB(255, 0, 0)
End Sub