' Cocher Reference : Microsoft Forms 2.0 Object Library
Sub Recuperer()
Dim PDDoc As Object
Dim PDPage As Object
Dim PDText As Object
Dim TextSelt As Object
Dim Rep As Long
Dim i As Long, j As Long
Dim wkPage As Long
Dim wkCnt As Long
Dim wkText As String
Dim FName As String
Dim oDO As Object
FName = "D:\Mes_Dossiers\FACTURES_INTER\260523.pdf"
Set PDDoc = CreateObject("AcroExch.PDDoc")
Rep = PDDoc.Open(FName)
Set TextSelt = CreateObject("AcroExCh.HiliteList")
TextSelt.Add 0, 32767
wkPage = PDDoc.GetNumPages()
For i = 0 To wkPage - 1
Set PDPage = PDDoc.AcquirePage(i)
Set PDText = PDPage.CreatePageHilite(TextSelt)
wkCnt = PDText.GetNumText()
For j = 0 To wkCnt - 1
wkText = wkText & PDText.GetText(j)
Next j
Next i
PDDoc.Close
Set PDPage = Nothing
Set PDText = Nothing
Set oDO = New MSForms.DataObject
oDO.Clear
oDO.SetText wkText
oDO.PutInClipboard
Application.ScreenUpdating = False
ActiveSheet.Cells.Clear
ActiveSheet.Range("A1").PasteSpecial
Set oDO = Nothing
Set TextSelt = Nothing
Set PDDoc = Nothing
ActiveSheet.Range("H1").Select
Application.ScreenUpdating = True
End Sub