Option Explicit
#If Win64 Then 'si version Excel 2010 ou 2013 et 64 bits
Declare PtrSafe Sub ClientToScreen Lib "user32" _
(ByVal hwnd As Long, lpPoint As POINT)
Declare PtrSafe Function FindWindow Lib "user32" _
Alias "FindWindowA" _
(ByVal lpClassName As String, _
ByVal lpWindowName As String) As Long
Declare PtrSafe Function FindWindowEx Lib "user32.dll" Alias "FindWindowExA" ( _
ByVal hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpsz1 As String, _
ByVal lpsz2 As String) As Long
Declare PtrSafe Sub GetClientRect Lib "user32" _
(ByVal hwnd As Long, lpRect As RECT)
Declare PtrSafe Function GetWindowRect Lib "user32" _
(ByVal hwnd As Long, lpRect As RECT) As Long
Declare PtrSafe Sub keybd_event Lib "user32.dll" _
(ByVal bVk As Byte, ByVal bScan As Byte, ByVal dwFlags As Long, ByVal dwExtraInfo As Long)
Declare PtrSafe Sub mouse_event Lib "user32" _
(ByVal dwFlags As Long, ByVal dx As Long, ByVal dy As Long, _
ByVal cButtons As Long, ByVal dwExtraInfo As Long)
Declare PtrSafe Function SetCursorPos Lib "user32" _
(ByVal x As Long, ByVal y As Long) As Long
Declare PtrSafe Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" ( _
ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, _
ByVal lpParameters As String, ByVal lpDirectory As String, _
ByVal nShowCmd As Long) As Long
Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Declare PtrSafe Function OpenClipboard Lib "user32" (ByVal hwnd As Long) As Long
Declare PtrSafe Function EmptyClipboard Lib "user32" () As Long
Declare PtrSafe Function CloseClipboard Lib "user32" () As Long
#Else
Declare Sub ClientToScreen Lib "user32" _
(ByVal hwnd As Long, lpPoint As POINT)
Declare Function FindWindow Lib "user32" _
Alias "FindWindowA" _
(ByVal lpClassName As String, _
ByVal lpWindowName As String) As Long
Declare Function FindWindowEx Lib "user32.dll" Alias "FindWindowExA" ( _
ByVal hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpsz1 As String, _
ByVal lpsz2 As String) As Long
Declare Sub GetClientRect Lib "user32" _
(ByVal hwnd As Long, lpRect As RECT)
Declare Function GetWindowRect Lib "user32" _
(ByVal hwnd As Long, lpRect As RECT) As Long
Declare Sub keybd_event Lib "user32.dll" _
(ByVal bVk As Byte, ByVal bScan As Byte, ByVal dwFlags As Long, ByVal dwExtraInfo As Long)
Declare Sub mouse_event Lib "user32" _
(ByVal dwFlags As Long, ByVal dx As Long, ByVal dy As Long, _
ByVal cButtons As Long, ByVal dwExtraInfo As Long)
Declare Function SetCursorPos Lib "user32" _
(ByVal x As Long, ByVal y As Long) As Long
Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" ( _
ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, _
ByVal lpParameters As String, ByVal lpDirectory As String, _
ByVal nShowCmd As Long) As Long
Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Declare Function OpenClipboard Lib "user32" (ByVal hwnd As Long) As Long
Declare Function EmptyClipboard Lib "user32" () As Long
Declare Function CloseClipboard Lib "user32" () As Long
#End If
Const SW_NORMAL As Long = 1
Const MOUSEEVENTF_LEFTDOWN = &H2
Const MOUSEEVENTF_LEFTUP = &H4
Const KEYEVENTF_KEYUP = &H2
Const VK_CONTROL As Long = &H11
Const VK_C = 67
Const VK_V = 86
Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
Type POINT
x As Long
y As Long
End Type
'cocher Microsoft Forms 2.0 object library
Sub Recherche_Explorateur_Windows()
Dim Zone As RECT
Dim Pos As POINT
Dim Explorer_Window As Long
Dim WorkerW_Window As Long
Dim ReBarWindow32_Window As Long
Dim UniversalSearchBand_Window As Long
Dim Search_Box_Window As Long
Dim DataObj As New MSForms.DataObject
Dim Mon_texte As String
Dim RetVal As Long
'on vide le presse-papier
ClearClipboard
'on ouvre l'explorateur Windows
RetVal = ShellExecute(0, "open", "explorer.exe", "T:/Dossier1/Dossier2/...", 0, SW_NORMAL)
Sleep 1500
If RetVal = 2 Or RetVal = 3 Then
MsgBox "Chemin ou fichier non trouvé"
Exit Sub
End If
'on copie le texte de la cellule active dans le presse-papier
Mon_texte = ActiveCell.Text
DataObj.SetText Mon_texte
DataObj.PutInClipboard
'on identifie la fenêtre de saisie de l'explorateur Windows
Explorer_Window = FindWindow("CabinetWClass", vbNullString)
WorkerW_Window = FindWindowEx(Explorer_Window, 0&, "WorkerW", vbNullString)
ReBarWindow32_Window = FindWindowEx(WorkerW_Window, 0&, "ReBarWindow32", vbNullString)
UniversalSearchBand_Window = FindWindowEx(ReBarWindow32_Window, 0&, "UniversalSearchBand", vbNullString)
Search_Box_Window = FindWindowEx(UniversalSearchBand_Window, 0&, "Search Box", vbNullString)
'on se place dans la fenêtre de saisie y pour coller le contenu du presse-papier
SendKeys String:="{F3}", Wait:=True
keybd_event VK_CONTROL, 0, 0, 0
keybd_event VK_V, 0, 0, 0
keybd_event VK_V, 0, KEYEVENTF_KEYUP, 0
keybd_event VK_CONTROL, 0, KEYEVENTF_KEYUP, 0
keybd_event VK_CONTROL, 0, 0, 0
keybd_event VK_CONTROL, 0, KEYEVENTF_KEYUP, 0
Sleep 1000
SendKeys String:="{ENTER}", Wait:=True
End Sub
Sub ClearClipboard()
OpenClipboard (0&)
EmptyClipboard
CloseClipboard
End Sub
