1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292 293 294 295 296 297 298 299 300 301 302 303 304 305 306 307 308 309 310 311 312 313 314 315 316 317 318 319 320 321 322 323 324 325 326 327 328 329 330 331 332 333 334 335 336 337 338 339 340 341 342 343 344 345 346 347 348 349 350 351 352 353 354 355 356 357 358 359 360 361 362 363 364
| Option Compare Database
Const BM_CLICK As Long = &HF5&
Const BM_GETCHECK As Long = &HF0&
Const CB_FINDSTRINGEXACT As Long = &H158
Const CB_SETCURSEL As Long = &H14E
Const GW_CHILD As Long = 5
Const GW_HWNDFIRST As Long = 0
Const GW_HWNDLAST As Long = 1
Const GW_HWNDNEXT = 2
Const GW_HWNDPREV As Long = 3
Const VK_CONTROL As Long = &H11
Const VK_DOWN As Long = &H28
Const VK_D = 68
Const VK_F = 70
Const VK_W = 87
Const VK_RETURN As Long = &HD
Const VK_SHIFT As Long = &H10
Const WM_CLOSE As Long = &H10
Const WM_SETFOCUS As Long = &H7
Const WM_SETTEXT As Long = &HC
Const KEYEVENTF_KEYUP = &H2
Const MOUSEEVENTF_LEFTDOWN = &H2
Const MOUSEEVENTF_LEFTUP = &H4
Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
Public Type POINT
x As Long
y As Long
End Type
Dim RetVal As Long
Dim wName As String
Sub RechAv_AdobeAcrobatReaderDC()
Dim RetVal As Long
Dim wName As String
Dim wAReader As Long, wRechAv As Long
Dim wInt As Long, wTarget As Long
Dim wEditRA As Long, wId As Long
Dim wButton As Long, wComboBoxEx32 As Long
Dim wRechDossier As Long, wDossier As Long
Dim wEditRD As Long, wOK As Long
Dim wState As Long, ShState As Long
Dim OpenAReader As Long, ValRet As Long
Dim sAReader As String, aChercher As String
Dim Dossier As String, Chemin As String
Dim Cpt As Byte, Debut As Single
'Dim wName As String
Const Pause As Long = 200 'temps en milliceconde de pause : à adapter
Const Duree As Long = 5 'durée max en seconde au-delà de laquelle on sort de la boucle Do Loop (par sécurité) : à adapter
On Error GoTo GestErr
'--------- Paramètres à préciser en fonction de votre recherche ------------
aChercher = Forms!Formulaire1!txtRecherche 'terme copié dans la zone de texte de la fenêtre de recherche avancée
Dossier = Forms!Formulaire1!txtDossier 'dossier où la recherche a lieu
If Dossier = "Parcourir
" Then
Chemin = Forms!Formulaire1!txtChemin 'chemin qui sera copié dans la zone de texte de la boîte de dialogue "Rechercher un dossier"
Else
Chemin = vbNullString
End If
'-------------- Si Acrobat Reader DC est déjà ouvert on le ferme ---------------
wAReader = FindWindow("AcrobatSDIWindow", "Adobe Acrobat Reader DC")
If wAReader > 0 Then SendMessage wAReader, WM_CLOSE, 0&, 0&
'------------ Recherche du chemin d'Acrobat Reader DC sur l'ordinateur -----------
sAReader = LocaliserAcroReader
'----------------- Ouverture d'Acrobat Reader DC ----------------------------------
OpenAReader = WinExec(sAReader, 10)
If OpenAReader < 32 Then
MsgBox "Problème au niveau du chemin ou du fichier d'Acrobat Reader DC.", vbInformation, vbOKOnly, "Acrobat Reader DC"
Exit Sub
End If
'--------------- ouverture du panneau de recherche avancée -------------------
Debut = Timer
Do
DoEvents
wAReader = FindWindow("AcrobatSDIWindow", "Adobe Acrobat Reader DC") 'caption modifié dans AcrobatReader DC
Loop While wAReader = 0 And Timer < Debut + Duree
ValRet = SetForegroundWindow(wAReader)
If ValRet = 1 Then
keybd_event VK_SHIFT, 0, 0, 0
keybd_event VK_CONTROL, 0, 0, 0
keybd_event VK_F, 0, 0, 0
keybd_event VK_F, 0, KEYEVENTF_KEYUP, 0
keybd_event VK_SHIFT, 0, KEYEVENTF_KEYUP, 0
keybd_event VK_CONTROL, 0, KEYEVENTF_KEYUP, 0
Else
Fermer_AReader
MsgBox "Traitement avorté au niveau de l'ouverture de la fenêtre de recherche avancée : recommencez."
Exit Sub
End If
Debut = Timer
Do
DoEvents
wRechAv = FindWindow("AVL_AVWindow", "Recherche avancée")
Loop While wRechAv = 0 And Timer < Debut + Duree
SetForegroundWindow wRechAv
'-------- Recherche de la zone de texte pour coller la valeur contenue dans la variable aChercher -------
'recherche de l'identifiant de la fenêtre "Recherche avancée"
'wName = "Recherche avancée"
'wRechAv = TrouverId
'Sleep Pause
'A partir de la fenêtre de recherche avancée on descend dans l'arborescence
'jusqu'à atteindre la zone contenant les critères de la recherche
wInt = FindWindowEx(wRechAv, 0&, "AVL_AVView", "AVTopLevelTable")
wInt = FindWindowEx(wInt, 0&, "AVL_AVView", "AVTableContainerView")
wInt = FindWindowEx(wInt, 0&, "AVL_AVView", "AVTableContainerView")
wInt = GetWindow(wInt, GW_HWNDNEXT)
wInt = FindWindowEx(wInt, 0&, "AVL_AVView", "AVTableContainerView")
'wCible = wInt
'on atteint la zone de texte pour y noter le terme à rechercher
wName = "Mots entiers"
wInt = GetWindow(wInt, GW_HWNDNEXT)
wTarget = GetWindow(wInt, GW_HWNDNEXT)
wEditRA = TrouverId(wTarget)
Sleep Pause
wEditRA = GetWindow(wEditRA, GW_HWNDNEXT)
If wEditRA = 0 Then
Fermer_AReader
MsgBox "Traitement avorté au niveau du terme à chercher : recommencez."
Exit Sub
End If
SendMessage wEditRA, WM_SETTEXT, 0, ByVal aChercher
'--------- Où effectuer la recherche ------------------------------
wName = "Dans tous les documents PDF dans"
wId = TrouverId(wTarget)
Sleep Pause
wState = SendMessage(wId, BM_GETCHECK, 0&, 0&)
If wState = 0 Then SendMessage wId, BM_CLICK, 0&, 0&
'----------------- CheckBox Mot entier ------------------------------
wName = "Mots entiers"
wId = TrouverId(wTarget)
Sleep Pause
wState = SendMessage(wId, BM_GETCHECK, 0&, 0&)
ShState = IIf(Forms!Formulaire1!mot_entier = "oui", 1, 0)
If wState <> ShState Then SendMessage wId, BM_CLICK, 0&, 0&
'-------------- CheckBox Respect de la Casse --------------------------
wName = "Respect de la casse"
wId = TrouverId(wTarget)
Sleep Pause
wState = SendMessage(wId, BM_GETCHECK, 0&, 0&)
ShState = IIf(Forms!Formulaire1!casse = "oui", 1, 0)
If wState <> ShState Then SendMessage wId, BM_CLICK, 0&, 0&
'-------------- CheckBox Inclure les signets ----------------------------
wName = "Inclure les signets"
wId = TrouverId(wTarget)
Sleep Pause
wState = SendMessage(wId, BM_GETCHECK, 0&, 0&)
ShState = IIf(Forms!Formulaire1!signet = "oui", 1, 0)
If wState <> ShState Then SendMessage wId, BM_CLICK, 0&, 0&
'------------- CheckBox Inclure les commentaires --------------------------
wName = "Inclure les commentaires"
wId = TrouverId(wTarget)
Sleep Pause
wState = SendMessage(wId, BM_GETCHECK, 0&, 0&)
ShState = IIf(Forms!Formulaire1!commentaire = "oui", 1, 0)
If wState <> ShState Then SendMessage wId, BM_CLICK, 0&, 0&
'--------- Atteinte de la boîte de dialogue "Rechercher un dossier" ----------
'A partir de l'identifiant de la fenêtre cible (wTarget) : recherche de la fenêtre "Rechercher :"
wName = "Rechercher :"
wId = TrouverId(wTarget)
Sleep Pause
'A partir de la fenêtre "Rechercher :" : recherche de la combobox"
wButton = GetWindow(wId, GW_HWNDNEXT)
wComboBoxEx32 = GetWindow(wButton, GW_HWNDNEXT)
SendMessage wComboBoxEx32, WM_SETFOCUS, 0&, 0& 'donne le focus à la comboBox
'------------ Si "Parcourir..." est sélectionné -------------------------------
If Dossier = "Parcourir
" Then
'------------------- Fenêtre "Rechercher un dossier" --------------------------
'utilisation d'un compteur par sécurité : on limite le nombre de keybd_event à 20 juste au cas où la procédure s'emballerait...
Do While wRechDossier = 0 And Cpt < 20
DoEvents
keybd_event VK_DOWN, 0, 0, 0
keybd_event VK_DOWN, 0, KEYEVENTF_KEYUP, 0
wRechDossier = FindWindow("#32770", "Rechercher un dossier")
Sleep 100
Cpt = Cpt + 1
Loop
Sleep Pause
SetForegroundWindow wRechDossier
wDossier = FindWindowEx(wRechDossier, 0&, "SHBrowseForFolder ShellNameSpace Control", vbNullString)
wEditRD = GetWindow(wDossier, GW_HWNDNEXT)
wEditRD = GetWindow(wEditRD, GW_HWNDNEXT)
Sleep Pause * 2
If Chemin <> vbNullString Then SendMessage wEditRD, WM_SETTEXT, 0, ByVal Chemin 'chemin placé dans la zone de texte
'----- Action sur le bouton OK soit par la touche Entrée du clavier soit par un clic sur le bouton ----
wOK = GetWindow(wEditRD, GW_HWNDNEXT)
wOK = GetWindow(wOK, GW_HWNDNEXT)
wOK = GetWindow(wOK, GW_HWNDNEXT)
Sleep Pause
SendMessage wOK, BM_CLICK, 0&, 0& 'clic sur le bouton OK
'------------------------------------------------------------------------------------------
Else
ValRet = SendMessage(wComboBoxEx32, CB_FINDSTRINGEXACT, 0, ByVal Dossier)
If ValRet > -1 Then
SendMessage wComboBoxEx32, CB_SETCURSEL, ValRet, 0&
Else
Fermer_AReader
MsgBox "Le dossier sélectionné n'est pas retrouvé dans le menu déroulant " & _
"de la fenêtre de recherche avancée." & vbCrLf & _
"Ajoutez son nom complet dans la liste du fichier et recommencez."
Exit Sub
End If
End If
'--------------- Retour dans la fenêtre de recherche avancée pour lancer la recherche -------
wName = "Rechercher"
wId = TrouverId(wTarget)
Sleep Pause
SendMessage wId, BM_CLICK, 0&, 0& 'clic sur le bouton Rechercher
Exit Sub
GestErr:
Fermer_AReader
MsgBox "Erreur !" & vbCrLf & "n° : " & Err.Number & vbCrLf & "Description : " & Err.Description
Err.Clear
End Sub
Function TrouverId(Optional hwnd As Long)
'utilisation d'un compteur par sécurité pour éviter que la fonction entre dans une boucle infinie
Dim Cpt As Byte
On Error Resume Next
Do
DoEvents
Err.Clear
If hwnd = 0 Then
EnumWindows AddressOf EnumProc, ByVal 0&
Else
EnumChildWindows hwnd, AddressOf EnumProcChild, ByVal 0&
End If
TrouverId = RetVal
Cpt = Cpt + 1
If Cpt > 20 Then Exit Function
Loop Until Err.Number = 0
On Error GoTo 0
End Function
Private Function LocaliserAcroReader() As String
Dim FSO As Object
Dim Wsh As Object
Dim sCheminReader As String
Set FSO = CreateObject("Scripting.FileSystemObject")
Set Wsh = CreateObject("WScript.Shell")
sCheminReader = Wsh.RegRead("HKLM\SOFTWARE\Microsoft\Windows\CurrentVersion\App Paths\AcroRd32.exe\")
If Not IsNull(FSO.GetAbsolutePathName(sCheminReader)) Then
LocaliserAcroReader = FSO.GetAbsolutePathName(sCheminReader)
Else
LocaliserAcroReader = ""
End If
Set Wsh = Nothing
Set FSO = Nothing
End Function
Function EnumProc(ByVal hwnd As Long, ByVal lParam As Long) As Long
Dim sSave As String
sSave = VBA.Space$(GetWindowTextLength(hwnd) + 1)
GetWindowText hwnd, sSave, Len(sSave)
sSave = VBA.Left$(sSave, Len(sSave) - 1)
If sSave = wName Then
RetVal = hwnd: Exit Function
End If
EnumProc = 1
End Function
Function EnumProcChild(ByVal hwnd As Long, ByVal lParam As Long) As Long
Dim sSave As String
sSave = VBA.Space$(GetWindowTextLength(hwnd) + 1)
GetWindowText hwnd, sSave, Len(sSave)
sSave = VBA.Left$(sSave, Len(sSave) - 1)
If sSave = wName Then
RetVal = hwnd: Exit Function
End If
EnumProcChild = 1
End Function
Sub Fermer_AReader()
Dim wPdf As Long
Do
DoEvents
wPdf = FindWindow("AcrobatSDIWindow", vbNullString)
SendMessage wPdf, WM_CLOSE, 0&, 0&
Loop While wPdf > 0
End Sub |
Partager