'******************************************************************************************************************************************************
' ___ _ _______ __ _ ____ _ _ _______ ___ _ _ _ ___ _ _.
' // \\ /\\ // // \\ // // // // // // \\ // // // // \\ //| //
' //___// //__\ // //__// // // //__|| // // // // // // // // // | //
' // // \\ // // \\ // // // \\ // // // // // // // // // | //
'// // // // // // // //___ // \\ // \\__// //__// //___ \\__// // |//
'******************************************************************************************************************************************************
'-----------------------------------------
'pdf grabber
'[@patricktoulon] on exceldownloads
'adding Chrome firefox control in an select case
'reduction of (window ready wait times) for (chrome or firefox)
'added clipboard management
'non-empty clipboard wait loop
'loading time lasts the time the clipboard takes to load the data
'updated V 2
'replacing wscript.shell.sendkeys
'by simulating keys with Api keybd_event
'the numeric keypad is no longer disabled
'-----------------------------------------
'Option Explicit
Private Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Private Declare PtrSafe Sub keybd_event Lib "user32" (ByVal bVk As Byte, ByVal bScan As Byte, ByVal dwFlags As Long, ByVal dwExtraInfo As Long)
Private 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 LongPtr)
Declare PtrSafe Function GetActiveWindow Lib "user32" () As LongPtr
'mouse_event() dwFlags
Private Const MOUSEEVENTF_LEFTDOWN = &H2
Private Const MOUSEEVENTF_LEFTUP = &H4
Function GrabbTextInPdF(FichierPDF As String) As String
Dim nav$, T$, clip As Object, wshshell As Object, essai,hwnD as longptr
Cells(1, 1).CurrentRegion.ClearContents
'browser path constantes
Const nav1 = "C:\Program Files\Google\Chrome\Application\chrome.exe"
Const nav2 = "C:\Program Files (x86)\Google\Chrome\Application\chrome.exe"
Const nav3 = "C:\Program Files\Mozilla Firefox\firefox.exe"
Const nav4 = "C:\Program Files (x86)\Mozilla Firefox\firefox.exe"
'select case true to find the browser installed on your system
Select Case True
Case Dir(nav1) <> "": nav = nav1
Case Dir(nav2) <> "": nav = nav2
Case Dir(nav3) <> "": nav = nav3 'je met le nav3 en premier je préfère firefox64
Case Dir(nav4) <> "": nav = nav4
Case Else
End Select
HWND = GetActiveWindow''le handle est le handle de l'application
'run the browser chosen in the select case
Call Shell(nav & " --new-window -url " & """" & FichierPDF & """", vbMaximizedFocus)
Do While hwnD= GetActiveWindow'boucle tant que l'on est sur le handle de l'application
Sleep 500 'increase if necessary
DoEvents
Loop
re:
'we create the clipboard object (late binding)no reference required
' we empty the clipboard
Set clip = Nothing
If essai = 4 Then MsgBox " 2 essais ont été effectués sans succès arrêt de la procédure": Exit Function
Set clip = CreateObject("New:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")
clip.SetText "": clip.PutInClipboard
'we still leave a minimum of 1 second for the window to be ready
'even if the document is not completely loaded
'loop and simulating (CTRL+A and C keys) as long as the clipboard is not full
Call mouse_event(MOUSEEVENTF_LEFTDOWN, 100, 100, 0, 0)
Call mouse_event(MOUSEEVENTF_LEFTUP, 100, 100, 0, 0)
Do While Len(T) = 0
keybd_event &H11, 1, 0, 0 'appuie sur la touche CTRL
keybd_event &H41, 1, 0, 0 'appuie sur la touche A
keybd_event &H41, 0, &H2, 0 'Lacher la touche A
keybd_event &H43, 1, 0, 0 'appuie sur la touche C
keybd_event &H43, 0, &H2, 0 'Lacher la touche C
keybd_event &H11, 0, &H2, 0 'Lacher la touche CTRL
On Error Resume Next
clip.GetFromClipboard
T = clip.GetText(1)
If Err Then Err.Clear: essai = essai + 1: GoTo re
DoEvents
Loop
Call mouse_event(MOUSEEVENTF_LEFTDOWN, 100, 100, 0, 0)
Call mouse_event(MOUSEEVENTF_LEFTUP, 100, 100, 0, 0)
'simulate CTRL+F4 keys to close browser window
keybd_event &H11, 1, 0, 0 'appuie sur la touche CTRL
keybd_event &H73, 0, 0, 0 'appuie sur la touche F4
keybd_event &H73, 0, &H2, 0 'Lacher la touche F4
keybd_event &H11, 0, &H2, 0 'Lacher la touche CTRL
'Temporisation 10
' MsgBox "il y a eu " & essai & " tentative(s)"
'return on worksheet
With ThisWorkbook.Worksheets(1)
.[A1].Select
.[A1].ClearContents
.Paste
GrabbTextInPdF = .[A1].Value
End With
Set clip = Nothing
End Function
Sub test2()
GrabbTextInPdF "C:\Users\patricktoulon\Desktop\trier un tableau avec la fonction sort d'excel 2023.pdf"
End Sub
