[Résolu] Copier plusieurs PDF au format Word

[Lone-wolf]

Bonjour le Forum,

suite à un post vu ici même où l'xlnaute explicait comment copier les données d'un pdf dans word, j'ai créer une petite appli qui fait tout ça automatiquement. Le problème c'est que en utilisant Shell, j'en peux modifier qu'un seul comme vous pouve le voir ici.

task = Shell("C:\Program Files (x86)\Adobe\Reader 11.0\Reader\AcroRd32.exe C:\Users\Lone-wolf\Documents\PDF_WORD\Liste_ventes.pdf", vbNormalFocus)

Trois autres problèmes: en utilisant FolloWHyperlink, je reçois deux messages comme quoi le fichier pourrait être potentiellement dangereux. En mettant ThisWorkbook.Path, Adobe Acrobat me signal que le fichier est introuvable, malgré qu'il soit inscrit dans sa fenêtre principale. Pour terminer, ShellExecute m'ouvre PDF Complete et non Adobe, et comme j'utilise un api pour Acrobat, je ne sais pas si il y a un moyen d'y apporter des modifications(que je ne sauraient faire).


Merci d'avance pour tout'aide apportée.




A+

 

[Lone-wolf]

Re : Copier plusieurs PDF au format Word

Bonsoir le Forum,

j'ai enfin trouver la solution pour pouvoir copier le PDF de son choix. Pour ceux qui seraient intéressés, voici le code.

'A rajouter dans le module de l'api pdf

Public Const DIR_A As String = "C:\Program Files (x86)\Adobe\Reader 11.0\Reader\AcroRd32.exe"
Public Const DIR_B As String = "C:\Users\Nom Utilisateur\Documents\PDF_WORD\"
Public Const DIR_C As String = "C:\Windows\notepad.exe C:\Users\Nom Utilisateur\Documents\Main.txt"



'Et directement sur la feuille

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim fso As Scripting.FileSystemObject, file As Object
Dim objProcess As Object, colProcessList As Object, objWMIService As Object
Dim strComputer As String, WordDoc, AcbDoc, line
Dim task, handle, result, npdDoc As Long


Application.WindowState = xlMinimized

AcbDoc = ActiveCell.Value

task = Shell(DIR_A & Chr(32) & DIR_B & AcbDoc & ".pdf", vbNormalFocus)
handle = OpenProcess(SYNCHRONIZE Or STANDARD_RIGHTS_REQUIRED Or &HFFF, _
False, task)

Application.Wait Now + TimeValue("00:00:2")
SendKeys "^a", True

Application.Wait Now + TimeValue("00:00:2")
SendKeys "^c", True


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

Set fso = New Scripting.FileSystemObject
Set file = fso.CreateTextFile("Main.txt", True)
npdDoc = Shell(DIR_C, vbNormalFocus)

SendKeys "^v", True

result = TerminateProcess(handle, 0)
result = CloseHandle(handle)


Application.Wait Now + TimeValue("00:00:2")
With file
SendKeys "^a", True
Application.Wait Now + TimeValue("00:00:2")
SendKeys "^c", True

Application.Wait Now + TimeValue("00:00:2")
 Set WordDoc = New Word.Application
   WordDoc.Documents.Add
   SendKeys "^v", True
   WordDoc.ActiveWindow.ActivePane.Selection.PasteAndFormat (wdPasteDefault)
   WordDoc.ActiveDocument.PageSetup.Orientation = wdOrientLandscape
   WordDoc.ActiveDocument.SaveAs ThisWorkbook.Path & "\" & AcbDoc & ".doc"
   WordDoc.Quit
End With


strComputer = "."
Set objWMIService = GetObject("winmgmts:" _
& "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")
Set colProcessList = objWMIService.execQuery _
("Select * from Win32_Process Where Name = 'Notepad.exe'")
For Each objProcess In colProcessList
objProcess.Terminate
Next
Application.WindowState = xlNormal
MsgBox "Transfert des données réussi.", , "PDF Converter"

End Sub

A+