Recherche dans l'explorateur windows

P

ptibaz

XLDnaute Junior
Bonjour à tous,

Avec une macro je souhaite copier la cellule active dans le presse papier et la coller dans la recherche de l'explorateur Windows 7

copier: je sais faire
'----- copier dans le presse papier
Dim TheData As String
TheData = libelle

With New DataObject
.SetText TheData
.PutInClipboard
End With
MsgBox "La sélection est copiée dans le presse papier"
'----------------------------------

ouvrir l'explorateur : je sais faire
'--- ouvrir l'explorateur
Dim ouvrir As String
'ouvrir = "c:\windows\explorer.exe " & ActiveWorkbook.Path
ouvrir = "c:\windows\explorer.exe " & "L:\Methodes\2 - PLANS + CODES STANDARDS"
Shell ouvrir, 1


mais coller ??? j'ai besoin d'aide SVP
2014-07-03 12_24_25-Document1 - Microsoft Word.png

merci d'avance
 
Trier par date Trier par votes
D

david84

XLDnaute Barbatruc
Re : Recherche dans l'explorateur windows

Bonjour,
un essai en passant par l'utilisation d'API Windows :
Code: 
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

ClearClipboard 'on vide le presse-papier

'on ouvre l'explorateur Windows
RetVal = ShellExecute(0, "open", "explorer.exe", 0, 0, SW_NORMAL)
Sleep 500

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
Pos.x = Zone.Left + 10
Pos.y = Zone.Top + 10
ClientToScreen UniversalSearchBand_Window, Pos
SetCursorPos Pos.x, Pos.y
mouse_event MOUSEEVENTF_LEFTDOWN + MOUSEEVENTF_LEFTUP, Pos.x, Pos.y, 0, 0
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
End Sub

Sub ClearClipboard()
    OpenClipboard (0&)
    EmptyClipboard
    CloseClipboard
End Sub
A+
 

Pièces jointes

  • Explorateur_Windows.xls
    54.5 KB · Affichages: 127
Dernière édition:
Vote positif 0 Vote négatif
D

david84

XLDnaute Barbatruc
Re : Recherche dans l'explorateur windows

Une autre version un peu différente :
Code: 
Option Explicit
#If Win64 Then 'si version Excel 2010 ou 2013 et 64 bits
  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 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 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 Sub keybd_event Lib "user32.dll" _
  (ByVal bVk As Byte, ByVal bScan As Byte, ByVal dwFlags As Long, ByVal dwExtraInfo 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
  
  Declare PtrSafe Function SendMessage Lib "user32.dll" Alias "SendMessageA" ( _
  ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, _
  ByRef lParam As Any) As Long
  
  Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
#Else
  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 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 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 OpenClipboard Lib "user32" (ByVal hwnd As Long) As Long
  
  Declare Function EmptyClipboard Lib "user32" () As Long
  
  Declare Function CloseClipboard Lib "user32" () As Long
  
  Declare Function SendMessage Lib "user32.dll" Alias "SendMessageA" ( _
  ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, _
  ByRef lParam As Any) As Long
  
  Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
#End If

Const SW_NORMAL As Long = 1
Const KEYEVENTF_KEYUP = &H2
Const VK_CONTROL As Long = &H11
Const VK_C = 67
Const VK_V = 86
Const WM_SETFOCUS As Long = &H7

'cocher Microsoft Forms 2.0 object library
Sub Recherche_Explorateur_Windows_2()
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

ClearClipboard 'on vide le presse-papier

'on ouvre l'explorateur Windows
RetVal = ShellExecute(0, "open", "explorer.exe", 0, 0, SW_NORMAL)
Sleep 500

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 donne le focus à la fenêtre de saisie y pour coller le contenu du presse-papier
SendMessage Search_Box_Window, WM_SETFOCUS, 0, ByVal 0&
Sleep 100
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
Sleep 100
ClearClipboard 'on vide le presse-papier
End Sub

Sub ClearClipboard()
    OpenClipboard (0&)
    EmptyClipboard
    CloseClipboard
End Sub
A+
 
Dernière édition:
Vote positif 0 Vote négatif
P

ptibaz

XLDnaute Junior
Re : Recherche dans l'explorateur windows

merci à tous pour vos réponses

j'ai choisi la méthode SENDKEY tab

'----- copier dans le presse papier
Dim TheData As String
TheData = libelle

With New DataObject
.SetText TheData
.PutInClipboard
End With

'---- Message Temporaire ---------
CreateObject("Wscript.shell").Popup nb & " cellules copiées dans le presse papier", 1, "Le Titre"
'----------------------------------



'--- ouvrir l'explorateur
Dim ouvrir As String
'ouvrir = "c:\windows\explorer.exe " & ActiveWorkbook.Path
ouvrir = "c:\windows\explorer.exe " & "L:\Methodes\2 - PLANS + CODES STANDARDS"
Shell ouvrir, 1

'-- PAUSE --
Dim start
start = Timer
Do While Timer < start + 1 'pause de 'x' secondes
DoEvents
Loop
'-----------



SendKeys "{TAB}"
SendKeys "{TAB}"
SendKeys "{TAB}"
SendKeys "^(v)" 'ctrl + V
SendKeys "{NUMLOCK}"


'-- PAUSE --
start = Timer
Do While Timer < start + 4 'pause de 'x' secondes
DoEvents
Loop
'-----------


'-- passer en affichage Détail
SendKeys "{TAB}"
SendKeys "{TAB}"
SendKeys "{TAB}"
SendKeys "%A"
SendKeys "D"
 
Vote positif 0 Vote négatif
MJ13

MJ13

XLDnaute Barbatruc
Re : Recherche dans l'explorateur windows

Bonjour à tous

En effet, très souvent, le sendkeys pertube le clavier numérique en désactivant la touche Verr. Num.

Vous pouvez aussi tester cette macro pour s'en affranchir.

Code: 
Sub Test_Sendkeys()
SendKeys "a~"
End Sub
Sub Réactive_Clavier_Numérique()
SendKeys "a~"
With Application
              DoEvents
          Application.SendKeys ("{NUMLOCK}"), True
          Application.SendKeys ("{NUMLOCK}"), True
End With
End Sub
 
Vote positif 0 Vote négatif
Roland_M

Roland_M

XLDnaute Barbatruc
Re : Recherche dans l'explorateur windows

bonjour à tous,

petites fonctions pour le clavier:

Code: 
Private Declare Function GetKeyState Lib "user32" (ByVal nVirtKey As Long) As Integer

'renvoi l'état
Function CapsLock() As Boolean
CapsLock = CBool(GetKeyState(20))
End Function

Function NumLock() As Boolean
NumLock = CBool(GetKeyState(144))
End Function

'met en majusc/minusc
Sub ClavierCapsLock(CapsLock As Boolean)
Dim EtatKey As Integer, TestEtat As Boolean
DoEvents
EtatKey = GetKeyState(vbKeyCapital)
TestEtat = (EtatKey = 1 Or EtatKey = -127)
If TestEtat <> CapsLock Then
   Dim WshShell As Object
   Set WshShell = CreateObject("WScript.Shell")
   WshShell.SendKeys "{CAPSLOCK}"
   Set WshShell = Nothing
End If
End Sub

'met en numlock ou pas
Sub ClavierNumlock(NumLock As Boolean)
Dim EtatKey As Integer, TestEtat As Boolean
DoEvents
EtatKey = GetKeyState(vbKeyNumlock)
TestEtat = (EtatKey = 1)
If TestEtat <> NumLock Then
   Dim WshShell As Object
   Set WshShell = CreateObject("WScript.Shell")
   WshShell.SendKeys "{NUMLOCK}"
   Set WshShell = Nothing
End If
End Sub

Sub Essai()
ClavierNumlock True
ClavierCapsLock True
End Sub
 
Vote positif 0 Vote négatif
Mastho

Mastho

XLDnaute Nouveau
Re : Recherche dans l'explorateur windows

Bonjour,

Je vous remercie déjà pour ce code qui marche très bien :)
Cependant j'ai une petite question: peut on changer le chemin du répertoire où s'effectue par défaut la recherche?
Par exemple moi la recherche s'effectue dans "C:\Mes Documents" et j'aimerais bien qu'elle s'effectue dans "T:\Dossier1\Dossier2" par exemple.

Merci par avance :)

Mastho.
 
Vote positif 0 Vote négatif
D

david84

XLDnaute Barbatruc
Re : Recherche dans l'explorateur windows

Mastho à dit:
Bonjour,

Je vous remercie déjà pour ce code qui marche très bien :)
Cependant j'ai une petite question: peut on changer le chemin du répertoire où s'effectue par défaut la recherche?
Par exemple moi la recherche s'effectue dans "C:\Mes Documents" et j'aimerais bien qu'elle s'effectue dans "T:\Dossier1\Dossier2" par exemple.

Merci par avance :)

Mastho.
Cliquez pour agrandir...

Bonjour,

si le dossier de recherche n'est pas "Documents" (celui qui est ouvert par défaut par la méthode ShellExecute) il te faut alors le préciser dans le 4ème argument de la méthode ShellExecute.

2 cas de figure :
- le dossier est un dossier "enfant" de "Documents" et se trouve sur le même disque : tu peux soit préciser le chemin complet ("C:\Users\aaa\Documents\xxx\yyy"), soit le chemin manquant à partir "de Documents" ("xxx\yyy").
- le dossier se trouve sur un autre disque que celui où est placé "Documents" : tu dois alors préciser le chemin complet.

Si dans ton cas tu as un disque T et que le dossier dans lequel tu veux mener ta recherche se trouve dans "Dossier2" tu dois donc préciser dans le 4ème argument le chemin T:\Dossier1\Dossier2

Teste donc en remplaçant
Code: 
RetVal = ShellExecute(0, "open", "explorer.exe", 0, 0, SW_NORMAL)
par
Code: 
RetVal = ShellExecute(0, "open", "explorer.exe", "T:\Dossier1\Dossier2", 0, SW_NORMAL)
A+
 
Vote positif 0 Vote négatif
Mastho

Mastho

XLDnaute Nouveau
Re : Recherche dans l'explorateur windows

Rebonjour à tous!
Après avoir joué un peu avec, voilà que je rencontre un petit problème..
Cela m'arrive souvent, quand je clique sur le bouton pour rechercher, l'explorateur s'ouvre (dans le bon dossier), mais le contenu de la cellule n'est pas copié et donc aucune recherche n'est lancée.. Et parfois l'explorateur s'ouvre mais en "fond"...
Serait-ce un problème de presse-papiers? Ou du format de l'écran?...
Quelqu'un aurait il une solution s'il vous plait?

Merci!! :)
 
Vote positif 0 Vote négatif

Discussions similaires

LUMBARDO
  • Question
Microsoft 365 Pb avec Windows
2 3 4
Réponses
47
Affichages
2 K
LUMBARDO
LUMBARDO
C
  • Question
XL 2013 Insérer un fichier texte dans un dossier
Réponses
4
Affichages
380
coline741
C
J
  • Question
XL 2019 PB de copier de valeur dans le presse papier
Réponses
6
Affichages
1 K
JPaul78
J
B
  • Question
XL 2021 Transfert tableau structuré EXCEL à un endroit précis de WORD
Réponses
8
Affichages
321
job75
job75
E
  • Question
XL 2016 Imports données fichier txt
Réponses
2
Affichages
806
Bernard_XLD
Bernard_XLD
M
  • Question
XL 2016 Instruction Cdate fait planter mon code
Réponses
3
Affichages
1 K
MONADESIGN82
M
LUMBARDO
  • Résolu(e)
Microsoft 365 Recherche Windows par VBA
Réponses
5
Affichages
2 K
LUMBARDO
LUMBARDO
A
  • Question
Microsoft 365 VBA: importer dans un dossier avec un nom variable
Réponses
4
Affichages
752
A-F
A
E
  • Résolu(e)
Microsoft 365 Function fSendTextToClipboard, ne fonctionne pas
Réponses
14
Affichages
1 K
patricktoulon
patricktoulon
C
  • Résolu(e)
XL 2016 Novice VBA - Copier coller cellule non vide dans autre onglet
Réponses
13
Affichages
1 K
Robert
Robert

Membres actuellement en ligne

15 membres et 198 invités.

Partager cette page

Tutos vidéos

Power Query : Ajouter des requêtes (Excel et Power BI)
Créez votre première fonction LAMBDA dans Excel en 3 étapes!
LAMBDA, l’arme secrète de Microsoft pour Excel !
Office Insider - Découvrez les nouveautés Excel avant tout le monde

Statistiques des forums

Discussions
312 240
Messages
2 086 514
Membres
103 239
dernier inscrit
wari