Private Declare Function CreateDC& Lib "gdi32" Alias "CreateDCA" (ByVal lpDriverName As String, ByVal lpDeviceName As String, ByVal lpOutput As String, lpInitData As Any)
Private Declare Function DeleteDC& Lib "gdi32" (ByVal hdc As Long)
Private Declare Function GetPixel Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long) As Long
Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long

Private Type POINTAPI
x As Long
y As Long
End Type
Dim z As POINTAPI

Private Sub кнопка_Click()
GetCursorPos z
screendc = CreateDC("DISPLAY", "", "", 0&)
MsgBox (GetPixel(screendc, z.x, z.y))
DeleteDC (screendc)
End Sub

Type point_
    X As Single
    Y As Single
End Type
Sub CrossPoint1()
Dim shp1 As Shape, line1 As Shape
Dim p1() As point_, p2(2) As point_
Dim po1() As Single
Dim count1 As Long
Dim K1 As Single, K2 As Single, d1 As Single, d2 As Single
Dim X As Single, Y As Single
Dim VF As Boolean, HF As Boolean
Dim diam As Single
Dim k As Integer
Set shp1 = ActiveSheet.Shapes("Полилиния 1")
Set line1 = ActiveSheet.Shapes("Прямая соединительная линия 8")
    With shp1.DrawingObject.ShapeRange.Nodes
        count1 = .Count
        ReDim p1(count1)
        For i = 1 To count1
            po1 = .Item(i).Points
            p1(i).X = po1(1, 1)
            p1(i).Y = po1(1, 2)
        Next i
    End With
    p2(1).X = line1.Left
    ' следующие свойства меняется при изменении положения отрезка в пространстве _
    (0-90: V=-1, H=0; 90-180: V=-1, H=-1; 180-270: V=0, H=-1; 270-360: V=0, H=0)
    VF = line1.DrawingObject.ShapeRange.VerticalFlip ' свойство меняется при изменении положения отрезка в пространстве
    HF = line1.DrawingObject.ShapeRange.HorizontalFlip ' свойство меняется при изменении положения отрезка в пространстве
    If VF = HF Then
        p2(1).X = line1.Left
        p2(1).Y = line1.Top
        p2(2).X = line1.Left + line1.Width
        p2(2).Y = line1.Top + line1.Height
    Else
        p2(1).X = line1.Left
        p2(1).Y = line1.Top + line1.Height
        p2(2).X = line1.Left + line1.Width
        p2(2).Y = line1.Top
    End If
    k = 10
    For i = 1 To count1 - 1
        K1 = (p1(i + 1).Y - p1(i).Y) / (p1(i + 1).X - p1(i).X)
        K2 = (p2(2).Y - p2(1).Y) / (p2(2).X - p2(1).X)
        d1 = (p1(i + 1).X * p1(i).Y - p1(i).X * p1(i + 1).Y) / (p1(i + 1).X - p1(i).X)
        d2 = (p2(2).X * p2(1).Y - p2(1).X * p2(2).Y) / (p2(2).X - p2(1).X)
        If (K1 <> K2) Then
            X = (d2 - d1) / (K1 - K2)
            Y = K1 * X + d1
        End If
        If belongs(X, Y, p1(i), p1(i + 1)) Then
            diam = 20 'диаметр кружков
            Set ff = ActiveSheet.Shapes.AddShape(msoShapeDonut, X - diam / 2, Y - diam / 2, diam, diam)
            ff.Line.ForeColor.RGB = RGB(255, 0, 0)
            k = k + 1
            Cells(k, 3) = X
            Cells(k, 4) = Y
        End If
    Next i
End Sub
Function belongs(X As Single, Y As Single, p1 As point_, p2 As point_) As Boolean
    Dim Xbool As Boolean
    Dim Ybool As Boolean
    If p1.X >= p2.X Then
        If X <= p1.X And X >= p2.X Then
           Xbool = True
        End If
    Else
        If X <= p2.X And X >= p1.X Then
           Xbool = True
        End If
    End If
    If p1.Y >= p2.Y Then
        If Y <= p1.Y And Y >= p2.Y Then
           Ybool = True
        End If
    Else
        If Y <= p2.Y And Y >= p1.Y Then
           Ybool = True
        End If
    End If
    belongs = Xbool And Ybool
End Function