Obtener datos de un archivo PDF (MACRO)
Publicado por carlos (36 intervenciones) el 10/08/2022 17:16:36
Un saludo,
Intento hacer una macro que extraiga datos de un archivo pdf (el que seleccione el usuario) y pegue las tablas en una hoja de Excel, mi problema es que necesito que la macro trabaje con el archivo que selecciono el usuario, en el momento el codigo lo tengo montado con una ruta especifica (C:\VARIOS\expertise.pdf").
Mil gracias por la ayuda
Bendiciones
Private Sub btnexaminer_Click()
With Application.FileDialog(msoFileDialogOpen)
.InitialFileName = Application.DefaultFilePath & " \ "
.Title = " Ouvrir fichier PDF"
.Filters.Clear
.Filters.Add "PDF files", "*.PDF"
.InitialView = msoFileDialogViewDetails
.Show
If .SelectedItems.count = 0 Then
Else
Me.txtnomfichierpdf.Value = .SelectedItems(1)
End If
End With
With Me
If .txtnomfichierpdf.Value <> "" Then
.btntelechargerpdf.Enabled = True
Else
.btntelechargerpdf.Enabled = False
End If
End With
End Sub
Private Sub btntelechargerpdf_Click()
ActiveWorkbook.Queries.Add Name:="Table001 (Page 1)", Formula:= _
"let" & Chr(13) & "" & Chr(10) & " Source = Pdf.Tables(File.Contents(""C:\VARIOS\expertise.pdf""), [Implementation=""1.3""])," & Chr(13) & "" & Chr(10) & " Table001 = Source{[Id=""Table001""]}[Data]," & Chr(13) & "" & Chr(10) & " #""Type modifié"" = Table.TransformColumnTypes(Table001,{{""Column1"", type text}})" & Chr(13) & "" & Chr(10) & "in" & Chr(13) & "" & Chr(10) & " #""Type modifié"""
With ActiveSheet.ListObjects.Add(SourceType:=0, Source:= _
"OLEDB;Provider=Microsoft.Mashup.OleDb.1;Data Source=$Workbook$;Location=""Table001 (Page 1)"";Extended Properties=""""" _
, Destination:=Range("$V$1")).QueryTable
.CommandType = xlCmdSql
.CommandText = Array("SELECT * FROM [Table001 (Page 1)]")
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.PreserveColumnInfo = True
.ListObject.DisplayName = "Table001__Page_1"
.Refresh BackgroundQuery:=False
End With
Application.CutCopyMode = False
Application.CutCopyMode = False
Application.CutCopyMode = False
ActiveWorkbook.Queries.Add Name:="Table002 (Page 1)", Formula:= _
"let" & Chr(13) & "" & Chr(10) & " Source = Pdf.Tables(File.Contents(""C:\VARIOS\expertise.pdf""), [Implementation=""1.3""])," & Chr(13) & "" & Chr(10) & " Table002 = Source{[Id=""Table002""]}[Data]," & Chr(13) & "" & Chr(10) & " #""En-têtes promus"" = Table.PromoteHeaders(Table002, [PromoteAllScalars=true])," & Chr(13) & "" & Chr(10) & " #""Type modifié"" = T" & _
"able.TransformColumnTypes(#""En-têtes promus"",{{""Localisation"", type text}, {""soumis"", Int64.Type}, {""Column3"", type text}, {""p/r au prix DSPR"", type text}, {""Column5"", type text}, {""Column6"", type text}, {""p/r estimation"", type text}, {""Column8"", type text}, {""Column9"", type text}})" & Chr(13) & "" & Chr(10) & "in" & Chr(13) & "" & Chr(10) & " #""Type modifié"""
With ActiveSheet.ListObjects.Add(SourceType:=0, Source:= _
"OLEDB;Provider=Microsoft.Mashup.OleDb.1;Data Source=$Workbook$;Location=""Table002 (Page 1)"";Extended Properties=""""" _
, Destination:=Range("$V$10")).QueryTable
.CommandType = xlCmdSql
.CommandText = Array("SELECT * FROM [Table002 (Page 1)]")
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.PreserveColumnInfo = True
.ListObject.DisplayName = "Table002__Page_1"
.Refresh BackgroundQuery:=False
End With
Application.CutCopyMode = False
Application.CutCopyMode = False
ActiveWorkbook.Queries.Add Name:="Table003 (Page 1)", Formula:= _
"let" & Chr(13) & "" & Chr(10) & " Source = Pdf.Tables(File.Contents(""C:\VARIOS\expertise.pdf""), [Implementation=""1.3""])," & Chr(13) & "" & Chr(10) & " Table003 = Source{[Id=""Table003""]}[Data]," & Chr(13) & "" & Chr(10) & " #""En-têtes promus"" = Table.PromoteHeaders(Table003, [PromoteAllScalars=true])," & Chr(13) & "" & Chr(10) & " #""Type modifié"" = T" & _
"able.TransformColumnTypes(#""En-têtes promus"",{{""code d'ouvrage"", type text}, {""Désignation de l'ouvrage"", type text}, {""Écart"", Int64.Type}, {""Column4"", type text}, {""% de l'écart"", type text}, {""Appréciation"", type text}})" & Chr(13) & "" & Chr(10) & "in" & Chr(13) & "" & Chr(10) & " #""Type modifié"""
With ActiveSheet.ListObjects.Add(SourceType:=0, Source:= _
"OLEDB;Provider=Microsoft.Mashup.OleDb.1;Data Source=$Workbook$;Location=""Table003 (Page 1)"";Extended Properties=""""" _
, Destination:=Range("$V$20")).QueryTable
.CommandType = xlCmdSql
.CommandText = Array("SELECT * FROM [Table003 (Page 1)]")
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.PreserveColumnInfo = True
.ListObject.DisplayName = "Table003__Page_1"
.Refresh BackgroundQuery:=False
End With
Application.CutCopyMode = False
Application.CutCopyMode = False
ActiveWorkbook.Queries.Add Name:="Page001", Formula:= _
"let" & Chr(13) & "" & Chr(10) & " Source = Pdf.Tables(File.Contents(""C:\VARIOS\expertise.pdf""), [Implementation=""1.3""])," & Chr(13) & "" & Chr(10) & " Page1 = Source{[Id=""Page001""]}[Data]," & Chr(13) & "" & Chr(10) & " #""En-têtes promus"" = Table.PromoteHeaders(Page1, [PromoteAllScalars=true])," & Chr(13) & "" & Chr(10) & " #""Type modifié"" = Table.Tr" & _
"ansformColumnTypes(#""En-têtes promus"",{{""Column1"", type text}, {""[image]"", type text}, {""Column3"", type text}, {""Column4"", type text}, {""Column5"", type text}, {""Column6"", type text}, {""Column7"", type text}, {""Column8"", type text}, {""Column9"", Int64.Type}, {""AUTORISATION DU SOUS-MINISTRE ADJOINT(SMECI)"", type text}, {""Column11"", Percentage.Typ" & _
"e}, {""Column12"", type text}, {""Column13"", type text}, {""Column14"", type text}, {""Column15"", type text}, {""Column16"", type text}, {""Column17"", type text}, {""Column18"", type text}, {""Column19"", type text}, {""Column20"", Int64.Type}, {""Column21"", type text}, {""Column22"", type text}, {""Column23"", type text}, {""Column24"", Percentage.Type}})" & Chr(13) & "" & Chr(10) & "in" & Chr(13) & "" & Chr(10) & "" & _
" #""Type modifié"""
With ActiveSheet.ListObjects.Add(SourceType:=0, Source:= _
"OLEDB;Provider=Microsoft.Mashup.OleDb.1;Data Source=$Workbook$;Location=Page001;Extended Properties=""""" _
, Destination:=Range("$V$40")).QueryTable
.CommandType = xlCmdSql
.CommandText = Array("SELECT * FROM [Page001]")
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.PreserveColumnInfo = True
.ListObject.DisplayName = "Page001"
.Refresh BackgroundQuery:=False
End With
Range("F4:H4").Select
End Sub
Private Sub UserForm_Click()
End Sub
Private Sub UserForm_Initialize()
Me.btntelechargerpdf.Enabled = False
Me.txtnomfichierpdf.Enabled = False
End Sub
Intento hacer una macro que extraiga datos de un archivo pdf (el que seleccione el usuario) y pegue las tablas en una hoja de Excel, mi problema es que necesito que la macro trabaje con el archivo que selecciono el usuario, en el momento el codigo lo tengo montado con una ruta especifica (C:\VARIOS\expertise.pdf").
Mil gracias por la ayuda
Bendiciones
Private Sub btnexaminer_Click()
With Application.FileDialog(msoFileDialogOpen)
.InitialFileName = Application.DefaultFilePath & " \ "
.Title = " Ouvrir fichier PDF"
.Filters.Clear
.Filters.Add "PDF files", "*.PDF"
.InitialView = msoFileDialogViewDetails
.Show
If .SelectedItems.count = 0 Then
Else
Me.txtnomfichierpdf.Value = .SelectedItems(1)
End If
End With
With Me
If .txtnomfichierpdf.Value <> "" Then
.btntelechargerpdf.Enabled = True
Else
.btntelechargerpdf.Enabled = False
End If
End With
End Sub
Private Sub btntelechargerpdf_Click()
ActiveWorkbook.Queries.Add Name:="Table001 (Page 1)", Formula:= _
"let" & Chr(13) & "" & Chr(10) & " Source = Pdf.Tables(File.Contents(""C:\VARIOS\expertise.pdf""), [Implementation=""1.3""])," & Chr(13) & "" & Chr(10) & " Table001 = Source{[Id=""Table001""]}[Data]," & Chr(13) & "" & Chr(10) & " #""Type modifié"" = Table.TransformColumnTypes(Table001,{{""Column1"", type text}})" & Chr(13) & "" & Chr(10) & "in" & Chr(13) & "" & Chr(10) & " #""Type modifié"""
With ActiveSheet.ListObjects.Add(SourceType:=0, Source:= _
"OLEDB;Provider=Microsoft.Mashup.OleDb.1;Data Source=$Workbook$;Location=""Table001 (Page 1)"";Extended Properties=""""" _
, Destination:=Range("$V$1")).QueryTable
.CommandType = xlCmdSql
.CommandText = Array("SELECT * FROM [Table001 (Page 1)]")
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.PreserveColumnInfo = True
.ListObject.DisplayName = "Table001__Page_1"
.Refresh BackgroundQuery:=False
End With
Application.CutCopyMode = False
Application.CutCopyMode = False
Application.CutCopyMode = False
ActiveWorkbook.Queries.Add Name:="Table002 (Page 1)", Formula:= _
"let" & Chr(13) & "" & Chr(10) & " Source = Pdf.Tables(File.Contents(""C:\VARIOS\expertise.pdf""), [Implementation=""1.3""])," & Chr(13) & "" & Chr(10) & " Table002 = Source{[Id=""Table002""]}[Data]," & Chr(13) & "" & Chr(10) & " #""En-têtes promus"" = Table.PromoteHeaders(Table002, [PromoteAllScalars=true])," & Chr(13) & "" & Chr(10) & " #""Type modifié"" = T" & _
"able.TransformColumnTypes(#""En-têtes promus"",{{""Localisation"", type text}, {""soumis"", Int64.Type}, {""Column3"", type text}, {""p/r au prix DSPR"", type text}, {""Column5"", type text}, {""Column6"", type text}, {""p/r estimation"", type text}, {""Column8"", type text}, {""Column9"", type text}})" & Chr(13) & "" & Chr(10) & "in" & Chr(13) & "" & Chr(10) & " #""Type modifié"""
With ActiveSheet.ListObjects.Add(SourceType:=0, Source:= _
"OLEDB;Provider=Microsoft.Mashup.OleDb.1;Data Source=$Workbook$;Location=""Table002 (Page 1)"";Extended Properties=""""" _
, Destination:=Range("$V$10")).QueryTable
.CommandType = xlCmdSql
.CommandText = Array("SELECT * FROM [Table002 (Page 1)]")
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.PreserveColumnInfo = True
.ListObject.DisplayName = "Table002__Page_1"
.Refresh BackgroundQuery:=False
End With
Application.CutCopyMode = False
Application.CutCopyMode = False
ActiveWorkbook.Queries.Add Name:="Table003 (Page 1)", Formula:= _
"let" & Chr(13) & "" & Chr(10) & " Source = Pdf.Tables(File.Contents(""C:\VARIOS\expertise.pdf""), [Implementation=""1.3""])," & Chr(13) & "" & Chr(10) & " Table003 = Source{[Id=""Table003""]}[Data]," & Chr(13) & "" & Chr(10) & " #""En-têtes promus"" = Table.PromoteHeaders(Table003, [PromoteAllScalars=true])," & Chr(13) & "" & Chr(10) & " #""Type modifié"" = T" & _
"able.TransformColumnTypes(#""En-têtes promus"",{{""code d'ouvrage"", type text}, {""Désignation de l'ouvrage"", type text}, {""Écart"", Int64.Type}, {""Column4"", type text}, {""% de l'écart"", type text}, {""Appréciation"", type text}})" & Chr(13) & "" & Chr(10) & "in" & Chr(13) & "" & Chr(10) & " #""Type modifié"""
With ActiveSheet.ListObjects.Add(SourceType:=0, Source:= _
"OLEDB;Provider=Microsoft.Mashup.OleDb.1;Data Source=$Workbook$;Location=""Table003 (Page 1)"";Extended Properties=""""" _
, Destination:=Range("$V$20")).QueryTable
.CommandType = xlCmdSql
.CommandText = Array("SELECT * FROM [Table003 (Page 1)]")
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.PreserveColumnInfo = True
.ListObject.DisplayName = "Table003__Page_1"
.Refresh BackgroundQuery:=False
End With
Application.CutCopyMode = False
Application.CutCopyMode = False
ActiveWorkbook.Queries.Add Name:="Page001", Formula:= _
"let" & Chr(13) & "" & Chr(10) & " Source = Pdf.Tables(File.Contents(""C:\VARIOS\expertise.pdf""), [Implementation=""1.3""])," & Chr(13) & "" & Chr(10) & " Page1 = Source{[Id=""Page001""]}[Data]," & Chr(13) & "" & Chr(10) & " #""En-têtes promus"" = Table.PromoteHeaders(Page1, [PromoteAllScalars=true])," & Chr(13) & "" & Chr(10) & " #""Type modifié"" = Table.Tr" & _
"ansformColumnTypes(#""En-têtes promus"",{{""Column1"", type text}, {""[image]"", type text}, {""Column3"", type text}, {""Column4"", type text}, {""Column5"", type text}, {""Column6"", type text}, {""Column7"", type text}, {""Column8"", type text}, {""Column9"", Int64.Type}, {""AUTORISATION DU SOUS-MINISTRE ADJOINT(SMECI)"", type text}, {""Column11"", Percentage.Typ" & _
"e}, {""Column12"", type text}, {""Column13"", type text}, {""Column14"", type text}, {""Column15"", type text}, {""Column16"", type text}, {""Column17"", type text}, {""Column18"", type text}, {""Column19"", type text}, {""Column20"", Int64.Type}, {""Column21"", type text}, {""Column22"", type text}, {""Column23"", type text}, {""Column24"", Percentage.Type}})" & Chr(13) & "" & Chr(10) & "in" & Chr(13) & "" & Chr(10) & "" & _
" #""Type modifié"""
With ActiveSheet.ListObjects.Add(SourceType:=0, Source:= _
"OLEDB;Provider=Microsoft.Mashup.OleDb.1;Data Source=$Workbook$;Location=Page001;Extended Properties=""""" _
, Destination:=Range("$V$40")).QueryTable
.CommandType = xlCmdSql
.CommandText = Array("SELECT * FROM [Page001]")
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.PreserveColumnInfo = True
.ListObject.DisplayName = "Page001"
.Refresh BackgroundQuery:=False
End With
Range("F4:H4").Select
End Sub
Private Sub UserForm_Click()
End Sub
Private Sub UserForm_Initialize()
Me.btntelechargerpdf.Enabled = False
Me.txtnomfichierpdf.Enabled = False
End Sub
Valora esta pregunta


0