Bonjour à tous
Voilà j'ai un problème, je dois extraire tous les Rapports PDF du site de production compris dans un dossier en les copiant collant littéralement. En collant par exemple en A1, je souhaite que toutes mes données se copient en colonne A à raison de UNE donnée par cellule excel. J'ai ensuite une autre fonction qui se charge d'identifier les diverses valeurs que j'assigne dans diverses tableaux sur le même document excel.
N'étant pas expert en VBA et surtout en manipulation de fichiers PDF, j'ai récupéré une fonction préremplie à base de sendKeys, mais qui ne me semble pas extrêmement fiable. Néanmoins, c'est la seule manière de faire que je comprends plus ou moins bien.
Après avoir essayé en vain de faire fonctionner SendKeys "^v", True, je suis passé à PasteSpecial. Malheureusement, le résultat est totalement aléatoire et de manière générale avant le 3ème PDF, il se met à coller sous une forme différente (en regroupant toutes les données de chaque ligne des tableaux présents dans les fichiers PDF dans une seule cellule Excel).
Voici une copie du code :
Code : Sélectionner tout - Visualiser dans une fenêtre à part
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84 Dim wsOutp As Worksheet Sub LoopThroughFiles() Dim strFile As String, strPath As String Dim colFiles As New Collection Dim i As Integer Dim rLog As Range, rOut As Range Dim wsLog As Worksheet strPath = "M:\...\2016 Informes\09 Septiembre\" strFile = Dir(strPath) ' Make a log sheet On Error Resume Next Set wsLog = Sheets("PdfProcessLog") On Error GoTo 0 If wsLog Is Nothing Then Set wsLog = ThisWorkbook.Sheets.Add(before:=Sheets(1)) wsLog.Name = "PdfProcessLog" End If Set rLog = wsLog.Range("A1") rLog.CurrentRegion.ClearContents rLog.Value = "PDF files copied to sheets" ' load all the files in a Collection While strFile <> "" If StrComp(Right(strFile, 3), "pdf", vbTextCompare) = 0 Then colFiles.Add strFile End If strFile = Dir Wend Application.DisplayAlerts = False 'Loop through the pdf's stored in the collection For i = 1 To colFiles.Count 'List filenames in Column A of the log sheet rLog.Offset(i, 0).Value = colFiles(i) strFile = Left(colFiles(i), Len(colFiles(i)) - 4) ' Delete sheet with filename if exists On Error Resume Next Set wsOutp = Sheets(strFile) On Error GoTo 0 If Not wsOutp Is Nothing Then wsOutp.Delete End If ' (Re)Create the worksheet, give it the file name Set wsOutp = ThisWorkbook.Sheets.Add(after:=wsLog) wsOutp.Name = strFile ' Now open the file, and copy contents OpenClosePDF colFiles(i), strPath CopyStep wsOutp Call Agregar_Reporte Next i Application.DisplayAlerts = True End Sub Sub OpenClosePDF(ByVal sAdobeFile As String, ByVal sPath As String) Dim sAdobeApp As String Dim vStartAdobe As Variant sAdobeApp = "C:\Program Files (x86)\Adobe\Acrobat 5.0\Reader\AcroRd32.exe" sAdobeApp = "C:\Program Files\Adobe\Reader 11.0\Reader\AcroRd32.exe" vStartAdobe = Shell("" & sAdobeApp & " " & sPath & sAdobeFile & "", 1) Application.Wait (Now + TimeValue("0:00:02")) End Sub Private Sub CopyStep(wsOutp As Worksheet) SendKeys "^a", True SendKeys "^c", True Application.Wait (Now + TimeValue("0:00:02")) wsOutp.Cells(1, 1).PasteSpecial Application.Wait (Now + TimeValue("0:00:08")) ' AppActivate "Adobe Reader" ' close Reader SendKeys "%{F4}", True End Sub
Partager