Ouvrir et scanner un pdf

[Mgn_91]

Bonjour à tous,

J'ai aujourd'hui une macro qui me permet :
d'ouvrir les PowerPoint
de relever tous les liens hypertext présents dans le documents
d'identifier la page et l'objet sur lequel se trouve le lien hypertext.

Je souhaite désormais transformer cette macro pour relever tous les liens hypertex présents dans un PDF et non un Powerpoint.

Voici le code que je souhaite adapter pour ouvrir et analyser les PDF :

Function ScanHyperlien(Ldoc As String, Llien As String, UpdateLink As String) As String

Dim A, B, C As Range

Set A = Sheets(Ldoc).Range("A2")
Set B = Sheets(Llien).Range("A2")
Set C = Sheets("Donnée").Range("B18")

Sheets(Llien).Range("A2:F10000").ClearContents

Dim PptApp As Variant
Set PptApp = CreateObject("Powerpoint.Application")

k = 0

While A.Offset(k, 0) <> ""
If Left(Right(A.Offset(k, 2), 3), 2) = "pp" Or Left(Right(A.Offset(k, 2), 3), 2) = "pt" Then
PptApp.Presentations.Open Filename:=C.Value & "\DossierA\" & A.Offset(k, 1) & "\" & A.Offset(k, 2)
'MsgBox C.Value & "\DossierA\" & A.Offset(k, 1) & "\" & A.Offset(k, 2)
Set myDocument = PptApp.Presentations(1)

'Nombre de slide dans la présentation
nbSlides = myDocument.Slides.Count
j = 1
While j <= nbSlides
' Nombre d'objets dans le slide
nbObjets = myDocument.Slides(j).Shapes.Count
i = 1
While i <= nbObjets
TextType = myDocument.Slides(j).Shapes(i).Type
If myDocument.Slides(j).Shapes(i).Type <> 6 And myDocument.Slides(j).Shapes(i).Type <> 12 Then
If myDocument.Slides(j).Shapes(i).ActionSettings(1).Hyperlink.Address <> "" Then
B.Offset(M, 0) = A.Offset(k, 2)
'B.Offset(M, 10) = myDocument.Slides(j).Shapes(i).Name
'MsgBox myDocument.Slides(j).Shapes(i).Type

If UpdateLink = "Y" Then
myDocument.Slides(j).Shapes(i).Name = "doc_" & k & "_slide_" & j & "_objet_" & i
End If
B.Offset(M, 1) = A.Offset(k, 2) & "_" & myDocument.Slides(j).Shapes(i).Name
B.Offset(M, 2) = myDocument.Slides(j).Shapes(i).ActionSettings(1).Hyperlink.Address
B.Offset(M, 3) = myDocument.Slides(j).Shapes(i).ActionSettings(1).Hyperlink.SubAddress
M = M + 1
PptApp.Presentations(1).Save
End If
End If
i = i + 1
Wend
j = j + 1
Wend
nbPrez = PptApp.Presentations.Count
' MsgBox nbPrez
For l = 1 To nbPrez
PptApp.Presentations(l).Close
Next l

End If
k = k + 1
Wend

ScanHyperlien = "Ok"

End Function


Merci pour votre aide