transfer de données pdf vers excel Fermé

Question

Bonjour, 

je souhaite récupérer des données d'un fichier pdf (tableau) vers une feuille excel.

j'ai trouver ce code : 

Option Explicit

Sub SelectionFichier2()
Dim FD As FileDialog

    Set FD = Application.FileDialog(msoFileDialogFilePicker)
    With FD
        .InitialFileName = ThisWorkbook.Path
        .AllowMultiSelect = False
        .Filters.Clear
        .Filters.Add "PDF", "*.pdf", 1
        .ButtonName = "Ouvrir fichier"
        .Title = "Sélectionner un fichier PDF"
    End With

    If FD.Show = True Then Lire2 FD.SelectedItems(1)

    Set FD = Nothing
End Sub

'   Cocher Reference : Microsoft Forms 2.0 Object Library
Sub Lire2(sFichier As String)
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 = sFichier
    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
    ShTest.Cells.Clear
    ShTest.Range("A1").PasteSpecial

    Set oDO = Nothing
    Set TextSelt = Nothing
    Set PDDoc = Nothing

    ShTest.Range("H1").Select
    Application.ScreenUpdating = True
End Sub

celui beugue 

j'ai un message erreur de compilation : qualificateur incorrect

merci pour votre aide


Configuration: Windows / Firefox 70.0

cs_Le Pivert · Answer

Bonjour,

essaie cela:

Option Explicit
Dim fileToOpen As Variant
Dim nom As String
Dim position As Integer
Dim longueur As Integer
Sub method1_copy_data_from_pdf()
fileToOpen = Application _
 .GetOpenFilename("PDF Files (*.pdf), *.pdf")
If fileToOpen <> False Then
End If
OuvertureDeFichier
longueur = Len(fileToOpen)
position = longueur - InStrRev(fileToOpen, "\", -1, 1)
nom = Right(fileToOpen, position)
nom = Replace(nom, ".pdf", ".xlsx")

' wait 2 secs
Application.Wait Now + TimeValue("00:00:2")

'send key to select all text
SendKeys "^a", True

' wait 2 secs
Application.Wait Now + TimeValue("00:00:2")

' send key to copy
SendKeys "^c"

' wait 2 secs
Application.Wait Now + TimeValue("00:00:2")
'création classeur
Workbooks.Add
ActiveWorkbook.SaveAs Filename:=ThisWorkbook.Path & "\" & nom ' nom classeur
' activate this workbook
Windows(nom).Activate ' nom classeur
Range("a1").Select 'a adapter
ActiveSheet.Paste

' Activate notepad
'AppActivate task

' send key to close pdf file
SendKeys "^q"
MsgBox "L'import c'est bien effectué.", vbInformation, "Import PDF"
SendKeys "{NUMLOCK}" 'on remet le verrouillage numérique
End Sub
Sub OuvertureDeFichier()
'par Excel-Malin.com ( https://excel-malin.com )

On Error GoTo OuvertureFichierErreur
   Dim MonApplication As Object
   Dim MonFichier As String
   Set MonApplication = CreateObject("Shell.Application")
   
   MonFichier = fileToOpen     'à remplacer par votre fichier
   MonApplication.Open (MonFichier)
   
   Set MonApplication = Nothing
Exit Sub

OuvertureFichierErreur:
   Set MonApplication = Nothing
    MsgBox "Erreur lors de l'ouverture de fichier..."
End Sub

Transfer de données pdf vers excel

1 réponse

Discussions similaires