Pour le test ouvre un nouveau classeur et ajouter un UF
'Mode d'emploi...
'dans le module de feuille mettre
'Private Sub Worksheet_SelectionChange(ByVal Target As Range)
' 'activer un UC et dessiner dessus (trouver sont HDC)
' UserForm1.Show
'End Sub
'2 modes, si la nouvelle sélection est A1 ou pas
'Sur la feuille sélectionner B1 pour mode 1
'Trace une ligne en suivant le déplacement de la souris.
'Sélectionner A1 pour mode 2
'Trace une ligne à partir d'un point central jusqu'a la position souris.
'Et efface la ligne précedante.
'Dans le module de l'UF1 mettre.....
Const PS_SOLID = 0
Private Type POINTAPI
X As Long
Y As Long
End Type
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Private Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long
Private Declare Function GetForegroundWindow Lib "user32" () As Long
Private Declare Function CreatePen Lib "gdi32" (ByVal nPenStyle As Long, ByVal nWidth As Long, ByVal crColor As Long) As Long
Private Declare Function LineTo Lib "gdi32" (ByVal hdc As Long, ByVal X As Long, ByVal Y As Long) As Long
Private Declare Function MoveToEx Lib "gdi32" (ByVal hdc As Long, _
ByVal X As Long, ByVal Y As Long, lpPoint As Any) As Long
Private Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function SetPixelV Lib "gdi32" (ByVal hdc As Long, ByVal X As Long, ByVal Y As Long, ByVal crColor As Long) As Byte
Private monhdc As Long
Dim Buff As Boolean
Dim TimeOnOFF As Boolean
Dim CurX As Integer, CurY As Integer
Dim ModeLigne As Boolean
Dim coul As Long
Private Sub UserForm_Activate()
If ActiveCell.Address = "$A$1" Then
CurX = Me.Width / 2
CurY = Me.Height / 2
coul = &H80C0FF
Me.BackColor = coul
ModeLigne = True
End If
End Sub
Private Sub UserForm_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
Buff = True
End Sub
Private Sub UserForm_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
If Not ModeLigne Then
Do While monhdc = 0
monhdc = GetForegroundWindow()
monhdc = GetDC(monhdc)
Loop
If Button <> 1 Then Exit Sub
hRPen = CreatePen(PS_SOLID, 10, RGB(0, 255, 0))
DeleteObject SelectObject(monhdc, hRPen)
If Buff Then
MoveToEx monhdc, X * 1.32, Y * 1.32, &H0
Buff = False
End If
LineTo monhdc, X * 1.32, Y * 1.32
DoEvents
End If
End Sub
Private Sub UserForm_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
Static MX As Integer
Static MY As Integer
If ModeLigne Then
Do While monhdc = 0
monhdc = GetForegroundWindow()
monhdc = GetDC(monhdc)
Loop
If MX > 0 Then
hRPen = CreatePen(PS_SOLID, 10, coul)
DeleteObject SelectObject(monhdc, hRPen)
MoveToEx monhdc, CurX * 1.32, CurY * 1.32, &H0
LineTo monhdc, MX * 1.32, MY * 1.32
End If
hRPen = CreatePen(PS_SOLID, 6, RGB(0, 255, 0))
DeleteObject SelectObject(monhdc, hRPen)
MoveToEx monhdc, CurX * 1.32, CurY * 1.32, &H0
LineTo monhdc, X * 1.32, Y * 1.32
End If
MX = X: MY = Y
End Sub
A toi de voir pour sélectionner les points X et Y
A+