Option Explicit
'
Private Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Private Declare PtrSafe Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassname As String, ByVal lpWindowName As String) As LongPtr
Private Declare PtrSafe Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As LongPtr, ByVal wMsg As Long, ByVal wParam As Long, lParam As Long) 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 Const WM_CLOSE As Integer = &H10
Sub test_dudu()
GetPDFText "C:\Users\patricktoulon\Desktop\trier un tableau avec la fonction sort d'excel 2023.pdf"
End Sub
'-----------------------
'Returns a PDF file text
'-----------------------
Function GetPDFText(FichierPDF As String) As String
Dim Clipboard As Object
Dim ChromeExe As String
Dim NomPDF As String
Dim hWnd As LongPtr
Dim nav As String
Dim PartTitle As String '
Const SleepTime = 500
Set Clipboard = CreateObject("New:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")
'Check file
If Len(Dir(FichierPDF)) = 0 Then
MsgBox "Fichier <" & FichierPDF & "> non trouvé !"
Exit Function
End If
'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: PartTitle = " - Google Chrome"
Case Dir(nav2) <> "": nav = nav2: PartTitle = " - Google Chrome"
Case Dir(nav4) <> "": nav = nav4: PartTitle = " - Mozilla Firefox"
Case Dir(nav3) <> "": nav = nav3: PartTitle = " - Mozilla Firefox"
'possible other browsers
Case Else
End Select
'PDF file name
NomPDF = Mid(FichierPDF, InStrRev(FichierPDF, "\") + 1)
'Empty the Clipboard
With Clipboard
.SetText ""
.PutInClipboard
End With
'Kill possible existing Windows
Do While 1
hWnd = FindWindow(vbNullString, NomPDF & PartTitle)
If Not hWnd = 0 Then
Call SendMessage(hWnd, WM_CLOSE, 0, 0)
DoEvents
Else
Exit Do
End If
Loop
'Run Chrome and wait for the Window to be ready
Call Shell(nav & " --new-window -url " & """" & FichierPDF & """", vbNormalFocus)
Sleep 1000
Do While hWnd = 0
hWnd = FindWindow(vbNullString, NomPDF & " - Google Chrome")
Temporisation 1000
Loop
Debug.Print "handle trouvé :" & hWnd
Sleep SleepTime
'Send keys to Select All / Copy / Kill the application
Call SendKeysSelectCopyClose
'Get Clipboard data
With Clipboard
.GetFromClipboard
On Error Resume Next
GetPDFText = .GetText
On Error GoTo 0
End With
End Function
'----------------------------
'Envoi des touches sur Chrome
'----------------------------
Private Sub SendKeysSelectCopyClose()
Const Tempo = 1000
SendKeybd "a", "ctrl" 'Touche Ctrl A
Temporisation Tempo
SendKeybd &H9 'Touche TAB
Temporisation Tempo
SendKeybd "c", "ctrl" 'Touche CTRL C
Temporisation Tempo
SendKeybd &H73, "alt" 'Touche ALT F4
End Sub
'--------------------------------------------
'Wrap keybd_event
'Alter = "down", "up", "shift", "ctrl", "alt"
'E.g. SendKeybd &H43, "ctrl" 'Send Ctrl C
'https://learn.microsoft.com/en-us/windows/win32/inputdev/virtual-key-codes
'--------------------------------------------
Sub SendKeybd(ByVal Key As Variant, Optional ByVal Alter As String = "")
Dim AlterValue As Byte
If VarType(Key) = vbString Then Key = Asc(Key)
Select Case UCase(Alter)
Case "DOWN"
keybd_event Key, 1, 0, 0
Case "UP"
keybd_event Key, 0, 2, 0
Case "SHIFT"
AlterValue = &H10
GoSub AlterKey
Case "CTRL"
AlterValue = &H11
GoSub AlterKey
Case "ALT"
AlterValue = &H12
GoSub AlterKey
Case Else
GoSub DownUp
End Select
Exit Sub
AlterKey:
keybd_event AlterValue, 1, 0, 0
GoSub DownUp
keybd_event AlterValue, 0, 2, 0
Return
DownUp:
keybd_event Key, 1, 0, 0
keybd_event Key, 0, 2, 0
Return
End Sub
'-------------
'Temporisation
'-------------
Private Sub Temporisation(NbDoEvents As Integer)
Dim k As Integer
For k = 1 To NbDoEvents
DoEvents
Next k
End Sub
