Excel mettre en couleur la ligne et la colonne de la cellule selection

Salut les ptits gars.

Aujourd'hui, je vous montre comment récupérer la cellule au dessus de laquelle le curseur de la souris se balade. Comme promis, c'est une usine à gaz !

Option Explicit

Obligatoire, sinon je m'énerve  

Private Type POINTAPI
    X As Long
    Y As Long
End Type
 
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpsz1 As String, ByVal lpsz2 As String) As Long
Private Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal hWnd As Long, ByVal lpString As String, ByVal cch As Long) As Long
Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
Private Declare Function WindowFromPoint Lib "user32" (ByVal xPoint As Long, ByVal yPoint As Long) As Long

Excel/VBa ne sait pas le faire. Windows, si. Voici les fonctions C présentent dans la DLL %windir%\system32\user32.dll qui vont nous être utiles.

Const UneSeconde As Double = #12:00:01 AM#
Dim Boucle As Boolean

Deux variables globales. C'est laid le VB  

Private Function WindowText(hWnd As Long) As String
    Dim s As String
    Dim l As Long
    Dim r As Long
    s = Space$(150)
    l = 149
    r = GetWindowText(hWnd, s, l)
    WindowText = Mid(s, 1, r)
End Function

Spa trivial de passer du C au VB.  
Cette fonction ne sert à rien, sinon à voir un peu mieux ce que nous faisons. Nous nous en servirons en debug pour voir le titre des fenêtres repérées.

Private Function CelluleSurvolee() As Range
    Dim hWndMain As Long
    Dim hWndDesk As Long
    Dim hWndSheet As Long
    Dim hWndCurs As Long
    Dim r As Long
    Dim p As POINTAPI
    Dim c As Range
 
    Set CelluleSurvolee = Nothing
 
    hWndMain = FindWindow("XLMAIN", Application.Caption)
    If hWndMain = 0 Then
        Debug.Print "Je n'ai trouvé la fenêtre principale d'Excel."
        Exit Function
    End If
    Debug.Print "J'ai trouvé la fenêtre principale d'Excel : [" & hWndMain & "] '" & WindowText(hWndMain) & "'"
 
    hWndDesk = FindWindowEx(hWndMain, 0, "XLDESK", vbNullString)
    If hWndDesk = 0 Then
        Debug.Print "Je n'ai trouvé la fenêtre principale d'Excel."
        Exit Function
    End If
    Debug.Print "J'ai trouvé la fenêtre MDI d'Excel : [" & hWndDesk & "] '" & WindowText(hWndDesk) & "'"
 
    hWndSheet = FindWindowEx(hWndDesk, 0, vbNullString, ActiveWindow.Caption)
    If hWndSheet = 0 Then
        Debug.Print "Je n'ai trouvé la fenêtre active d'Excel."
        Exit Function
    End If
    Debug.Print "J'ai trouvé la fenêtre active d'Excel : [" & hWndSheet & "] '" & WindowText(hWndSheet) & "'"
 
    r = GetCursorPos(p)
    Debug.Print "La souris, par rapport à l'écran, est là : " & p.X & "x" & p.Y
 
    hWndCurs = WindowFromPoint(p.X, p.Y)
    Debug.Print "La fenêtre sous la souris est : [" & hWndCurs & "] '" & WindowText(hWndCurs) & "'"
 
    If hWndCurs <> hWndSheet Then
        Debug.Print "La fenêtre sous la souris n'est pas la feuille Excel."
        Exit Function
    End If
    Debug.Print "Ca tombe, bien, c'est la fenêtre qu'on cherchait à survoler"
 
    Set c = ActiveWindow.RangeFromPoint(p.X, p.Y)
    If Not (c Is Nothing) Then
        Debug.Print "Voilà la cellule survolée : " & c.Address
        Set CelluleSurvolee = c
    End If
End Function

Yeepeeeeeee! C'est dans cette fonction que l'on récupère la cellule survolée.

Private Sub Survol()
    Dim cell As Range
 
    If Not Boucle Then Exit Sub
 
    Set cell = CelluleSurvolee
    If cell Is Nothing Then Range("A1").Value = "" Else Range("A1").Value = cell.Address
    DoEvents    
    Application.OnTime Now + UneSeconde, "Survol"
End Sub

C'est là que l'on boucle et qu'on fait quelque chose de la cellule récupérée. A la fin, on réarme le timer.

Public Sub Survol_Demarre()
    Boucle = True
    Application.OnTime Now + UneSeconde, "Survol"
End Sub

C'est ici qu'on initialise le timer et la boucle. C'est parti !

Public Sub Survol_Arrete()
    Boucle = False
End Sub

Stop !



Et voilà.  
Ne vous avais-je pas promis une usine à gaz ?