Bonjour kiki, concernant pdf2xls cela ne fonctionne pas mlaheureusement dans mon cas ... la macro ne fait pas l'extraction (la fiche pdf s'ouvre, mais après c'est l'erreur qui s'affiche ; ça ne passe pas au niveau "paste" (j'ai mis en rouge ci-dessous) :
Private Sub Pdf2Txt()
Dim sFichier As String
Dim sAcro As String
Dim LastRow As Long, i As Long, LastRow2 As Long
Dim iDep As Long, iFin As Long
Dim sDossier As String
Const Tempo As Long = 500
QueryPerformanceCounter Debut
EffacerClipboard
DoEvents
DecompteA
If Cpt = 0 Then
MsgBox "Taper dans la colonne A un x ou X en vis à vis" & vbCrLf & _
"des fichiers à traiter de la colonne B", vbInformation + vbOKOnly, "x ou X"
Exit Sub
End If
Application.StatusBar = ""
sDossier = ShParam.Cells(1, 1)
LastRow = ShParam.Range("B" & Rows.Count).End(xlUp).Row
ShExtraction.Activate
sAcro = LocaliserAcroReader
If ExistenceFichier(sAcro) = False Then
MsgBox "Le chemin d'Acrobat Reader est erroné ou" & vbCrLf & "Acrobat Reader n'est pas installé" & vbCrLf & vbCrLf & _
"Voir la procédure Pdf2Txt du module mPDF" & vbCrLf & "à sAcro = .....", vbInformation + vbOKOnly, "Chemin du Reader erroné"
Debug.Print sAcro
Exit Sub
End If
With ShExtraction
.Activate
.Cells.Delete Shift:=xlUp
.Range("A1").Select
End With
iDep = 0
iFin = LastRow - RDepart + 1
For i = RDepart To LastRow
If UCase$(ShParam.Range("A" & i)) = "X" Then
iDep = iDep + 1
sFichier = sDossier & "\" & ShParam.Range("B" & i)
Shell sAcro & " " & sFichier, vbNormalFocus
With CreateObject("WScript.Shell")
.SendKeys "^a^c", True
Sleep Tempo
.SendKeys "^q", True
Sleep 2 * Tempo
End With
LastRow2 = ShExtraction.Range("A" & Rows.Count).End(xlUp).Row
If LastRow2 = 1 Then LastRow2 = 0
DoEvents
With ShExtraction
.Activate
.Range("A" & LastRow2 + 2).Select
.Paste
End With
Application.StatusBar = "Extraction : " & iDep & " / " & Cpt
End If
DoEvents
Next i
' l'Appel des procédures de formatage des données extraites est à placer ici
With ActiveWindow
.ScrollColumn = 1
.ScrollRow = 1
End With
DoEvents
With ShExtraction
.Activate
.Range("B1").Select
End With
QueryPerformanceCounter Fin
QueryPerformanceFrequency Freq
Application.StatusBar = "Terminé : " & Format((Fin - Debut) / Freq, "0.00 s")
End Sub