Transfer de données pdf vers excel
yannick2638
Messages postés
5
Date d'inscription
Statut
Membre
Dernière intervention
-
yannick2638 Messages postés 5 Date d'inscription Statut Membre Dernière intervention -
yannick2638 Messages postés 5 Date d'inscription Statut Membre Dernière intervention -
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
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
A voir également:
- Extraire données pdf vers excel vba
- Lire le coran en français pdf - Télécharger - Histoire & Religion
- Extraire une video youtube - Guide
- Liste déroulante excel - Guide
- Extraire image pdf - Guide
- Trier des données excel - Guide
1 réponse
Bonjour,
essaie cela:
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
erreur defini par l'application ou par l'objet
https://www.cjoint.com/c/IKlmfOw8vvQ
@+ Le Pivert
voici un lien pour mon type de fichier : https://www.cjoint.com/c/IKlmsInHhzN