Aller à une page spécifique d'un PDF déjà ouvert VBA

Version imprimable

Bonjour,
Je souhaite ouvrir un fichier PDF à une page spécifique, le code qui suit fonctionne mais uniquement si le fichier n’est pas déjà ouvert :
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 Option Explicit Private Declare PtrSafe Function FindExecutable Lib "shell32.dll" Alias "FindExecutableA" _ (ByVal lpFile As String, ByVal lpDirectory As String, ByVal lpResult As String) As Long Sub OuvrirPdf() Dim strAcroPath As String, strFichier As String Dim intPage As Integer strAcroPath = String(128, 32) strFichier = C:\Users\antoi\Desktop\Nouveau dossier\Cassation 'A COMPLETER intPage = 10 'A COMPLETER If FindExecutable(strFichier, vbNullString, strAcroPath) <= 32 Then MsgBox "Adobe Acrobat Reader n'a pas été trouvé sur cet ordinateur", vbOKOnly + vbCritical, "Message d'erreur" Else strAcroPath = Left$(strAcroPath, InStr(strAcroPath, Chr$(0)) - 1) Shell strAcroPath & " /a page=" & intPage & " " & strFichier, vbNormalFocus End If End Sub
Avez-vous une idée de code pour le même but mais sur un fichier déjà ouvert ?
Car toutes les solutions que j’ai trouvé sur internet consiste à fermer le fichier déjà ouvert puis le réouvrir.

Si ce n’est pas possible via VBA un script VBS externe me conviendrais.

Merci d’avance pour vos réponses.

Essaie ce code pour voir s'il te convient :

Code:

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
85
 
Option Explicit
 
Private Declare Function GetDesktopWindow Lib "user32" () As Long
 
Private Declare Function GetWindow Lib "user32" _
  (ByVal Hwnd As Long, _
   ByVal wCmd As Long) As Long
 
Private Declare Function GetWindowText Lib "user32" _
   Alias "GetWindowTextA" _
  (ByVal Hwnd As Long, _
   ByVal lpString As String, _
   ByVal cch As Long) As Long
 
Private Declare Function PostMessage Lib "user32" Alias "PostMessageA" (ByVal Hwnd As Long, _
    ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
 
Private Declare Function GetClassName Lib "user32" _
   Alias "GetClassNameA" _
  (ByVal Hwnd As Long, _
   ByVal lpClassName As String, _
   ByVal nMaxCount As Long) As Long
 
Private Const GW_HWNDNEXT = 2
Private Const GW_CHILD = 5
Private Const WM_CLOSE = &H10
 
Private Declare Function BringWindowToTop Lib "user32" _
    (ByVal Hwnd As Long) As Long
 
Public Sub ChangeSlide(ByVal hWndStart As Long, _
                              ByVal WindowText As String, _
                              ByVal ClassName As String)
 
    Dim Hwnd As Long
    Dim sWindowText As String
    Dim sClassname As String
    Dim r As Long
    Dim PowerPointApp As PowerPoint.Application
    Dim myPresentation As PowerPoint.Presentation
    Dim Obj As PowerPoint.Shape
    Dim Graph As Workbook
 
      If hWndStart = 0 Then hWndStart = GetDesktopWindow()
 
 
   Hwnd = GetWindow(hWndStart, GW_CHILD)
 
   Do Until Hwnd = 0
 
      ChangeSlide Hwnd, WindowText, ClassName
 
      sWindowText = Space$(255)
      r = GetWindowText(Hwnd, sWindowText, 255)
      sWindowText = Left(sWindowText, r)
 
      sClassname = Space$(255)
      r = GetClassName(Hwnd, sClassname, 255)
      sClassname = Left(sClassname, r)
 
      If (sWindowText Like WindowText) And (sClassname Like ClassName) Then
        BringWindowToTop Hwnd
        Set PowerPointApp = CreateObject("Powerpoint.Application")
        PowerPointApp.Visible = msoTrue
 
        PowerPointApp.ActivePresentation.Slides(2).Select
        Exit Sub
      End If
 
      Hwnd = GetWindow(Hwnd, GW_HWNDNEXT)
 
   Loop
 
 
End Sub
 
 
Sub test2()
 
' en paramètres
' "*Forum*" : le nom du fichier que tu cherches
ChangeSlide 0, "*Forum*", "*PPTFrameClass*"
 
End Sub

16/08/2018, 17h22
Shooter422

Bonjour, merci d'avoir pris le temps de me répondre.

Je vais tester ton code dans les prochains jours, je te tiens au courant.
16/08/2018, 17h57
sogedic

Bonjour Bob78280

Comme j'avais cherché… sans trouvé j'ai voulu tester ton code
mais il me semble qu'il interagi avec un ppt et non un pdf ? ca reste cependant très intéressant
17/08/2018, 10h19
Bob78280

As-tu AcrobatWriter ou juste AcrobatReader?
17/08/2018, 10h48
sogedic

J'ai AcrobatReader, ma question était idiote ? ton code marche bien avec un pdf ?
17/08/2018, 10h54
Bob78280
Ce n'est pas une question idiote.
Le code est positionné pour du PowerPoint.

En changeant quelques variables, on peut le positionner pour du PDF, mais il faut AcrobatWriter.
En fait, ce code indique la création d'un objet même si ensuite on s'en sert que pour lire
Code:

1 2 CreateObject("AcroExch.App")
Je continue de chercher.

re
Bonjour a tous
SI SI!! solution il y a ;)
le principe
avec 3/4 api lister les fenetres
reperer le texte de la fenetre
tester si le text correspond au fichier visé qui est sensé etre ouvert meme par une autre application ou a la main
si ce texte est trouvé memo du handle
avec une petite api afficher ce pdf en plein ecran cette api a en meme temps donner le focus a cette fenetre pdf
il ne reste plus qu'a jouer avec les touches flecches gauche et droite
d'abord les fleches gauche pour ramener a la page 1 j'ai prevu 100 retours en arriere au cas ou le pdf serait deja dans une page de 1 a 100
et nous voila reparti avec la touche fleche droite autant de fois que l 'index de page voulue avec intpage

je suis sous Windows 7 office 2007 adobreader 9
c'est parti
une petite sub pour tester il ne reste plus qu'a changer le nom du fichier qui est sensé etre ouvert
il te serait facile d'en faire une fonction genérique

je pense que j'ai suffisement commenter le code plus que ca se sera des fables de "LAFONTAINE";)
LES API A ADAPTER BIEN ENTENDU EN 64 BITS (ptrsafe) je ne le fait car je n'utiliserais pas d'aussi tot une version 64 de office
Code:

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 Option Explicit Declare Function GetDesktopWindow Lib "user32" () As Long Declare Function GetNextWindow Lib "user32" Alias "GetWindow" (ByVal hwnd As Long, ByVal wFlag As Long) As Long Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal hwnd As Long, ByVal lpString As String, ByVal cch As Long) As Long Declare Function ShowWindow Lib "user32" (ByVal hwnd As Long, ByVal nCmdShow As Long) As Long 'exemple fichier = "G:\vba excel\image avec WIA\silkyroad.developpez.com WIA LIBRARY- .pdf" Sub test() Dim stTmp$, lgTmp&, lgRet&, Handle&, HandlePDF&, Nomfichier$, intpage&, i& stTmp = Space$(120) 'on prevois un buffer de 120 carateres pour les caption de fenetres visitées lgTmp = 119 'on pervoit le len aussi Nomfichier = "silkyroad.developpez.com WIA LIBRARY- .pdf" 'le fichier en exemple que j'ai ouvert a partir de son emplacement par l'explorateur Handle = GetDesktopWindow() ' on choppe le handle du bureau c'est le 1er handle Debug.Print "handle bureau " & Handle Handle = GetNextWindow(Handle, 5) ' on choppe la premiere fenetre enfant du bureau avec l'argument "5" d pour l'api getnextwindow Do While Handle <> 0 ' on va boucler jusqu'a que handle donne "0"(plus de fenetre) Handle = GetNextWindow(Handle, 2) 'on recupere la fentre enfant suivante du bureau dans le meme etage de la hierachie des fenetre (la soeur de la 1ere quoi) et cela avec l'argument "2"!!!!! GetWindowText Handle, stTmp, lgTmp ' on recupere le texte de la caption de la caption de la fenetre en cours Debug.Print Handle & ":" & stTmp ' control dans le debug (facultatif ) If stTmp Like "*" & Nomfichier & "*" Then HandlePDF = Handle: Exit Do 'et donc si le titre est trouvé on sort de la boucle avec le handlePDF renseigné Loop ShowWindow HandlePDF, 3 'on active donc la fentre et en plein ecran avec l'api showwindow ' je crois qu'il n'est pas necessaire d'expliquer ce qui suit c'est assez basique 'on c'réé un object wscriptshell pour manipuler les touche en dehors de l'application 'comme on a precedement activer la fentre du pdf on est sur que les sendkeys vont taper dedans intpage = 10 With CreateObject("wscript.shell") For i = 1 To 100: .SendKeys "{LEFT}": Next 'on ramene a la page 1 avec les touches fleche left For i = 1 To intpage - 1: .SendKeys "{RIGHT}": Next 'on va a la page voulue avec la touche fleche droite End With End Sub
si kiki passe par la et que ca l'interesse

bon tests ;)

EDIT:
j'ai fait ca en quelques minutes je n'ai pas pensé a mettre un gardefou au cas ou on sortirait de la boucle sans avoir trouvé la fenetre vous saurez faire je vous ai donné le moteur ;)

bon voila je l'ai remanier en une fonction generique sous deux forme

la premiere la fonction fait tout elle cherche active et affiche en plein ecran et va a la page voulue avec un garde fou en sortie de boucle si il ne l'a pas trouvé
la 2d version ne renvoie que le handle de la fenetre ou "0" si il ne la pas trouvé et le reste se passe dans la sub ansi que le gardefou

la premiere version celle qui fait tout en un

Code:

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
'***********************************************************************************
'        AFFICHER UNE PAGE PRECISE D UN PDF DEJA OUVERT AUTREMENT QUE PAR VBA      *
'date:17/08/2018                                                                   *
'auteur;patricktoulon chamalin2@hotmail.fr                                         *
'version 1.1                                                                       *
'***********************************************************************************
Option Explicit
Declare Function GetDesktopWindow Lib "user32" () As Long
Declare Function GetNextWindow Lib "user32" Alias "GetWindow" (ByVal hwnd As Long, ByVal wFlag As Long) As Long
Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal hwnd As Long, ByVal lpString As String, ByVal cch As Long) As Long
Declare Function ShowWindow Lib "user32" (ByVal hwnd As Long, ByVal nCmdShow As Long) As Long
'exemple fichier = "G:\vba excel\image avec WIA\silkyroad.developpez.com WIA  LIBRARY- .pdf"
Sub testx()
Dim Nomfichier$, Intpage&, x&
Nomfichier = "silkyroad.developpez.com WIA  LIBRARY- .pdf"    'le fichier en exemple que j'ai ouvert a partir de son emplacement par l'explorateur
'intpage = 10
x = affiche_la_page_du_PDF(Nomfichier, 10) ' affiche la page 10 du pdf si il est ouvert
MsgBox x
End Sub
    Function affiche_la_page_du_PDF(ByVal Nomfichier As String, ByVal Intpage As Long) As Long
    Dim stTmp$, lgTmp&, lgRet&, Handle&, HandlePDF&, i& 'variable necessaires
    stTmp = Space$(120): lgTmp = 119   'on prevois un buffer de 120 carateres pour les  caption de fenetres visitées et  pervoit le len aussi
     Handle = GetDesktopWindow()    ' on choppe le handle du bureau c'est le 1er handle
     Handle = GetNextWindow(Handle, 5)    ' on choppe la premiere fenetre enfant du bureau avec l'argument "5" d pour l'api getnextwindow
    Do While Handle <> 0    ' on va boucler jusqu'a que handle donne "0"(plus de fenetre)
        Handle = GetNextWindow(Handle, 2)    'on recupere la fentre enfant suivante du bureau dans le meme etage de la hierachie des fenetre (la soeur de la 1ere  quoi) et cela avec l'argument "2"!!!!!
        GetWindowText Handle, stTmp, lgTmp    ' on recupere le texte de la caption de la caption de la fenetre en cours
         If stTmp Like "*" & Nomfichier & "*" Then HandlePDF = Handle: Exit Do    'et donc si le titre est trouvé on sort de la boucle avec le handlePDF renseigné
    Loop
    If HandlePDF <> 0 Then ' garde fou au cas ou la fentre ne serait pas trouvée
        ShowWindow HandlePDF, 3    'on active donc la fentre et en plein ecran avec l'api showwindow
        ' je crois qu'il n'est pas necessaire d'expliquer ce qui suit c'est assez basique
        'on c'réé un object wscriptshell pour manipuler les touche en dehors de l'application
        'comme on a precedement activer la fentre du pdf on est sur que les sendkeys vont taper dedans
          With CreateObject("wscript.shell")
            For i = 1 To 100: .SendKeys "{LEFT}": Next    'on ramene a la page 1 avec les touches fleche left
            For i = 1 To Intpage - 1: .SendKeys "{RIGHT}": Next    'on va a la page voulue avec la touche fleche droite
        End With
    affiche_la_page_du_PDF = 1
    Else
        MsgBox "cette fentre n'a pas été trouvée"
    End If
End Function

la version 1.2 qui ne fait que trouver la fenetre et le reste se passe dans la sub

Code:

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
 
'***********************************************************************************
'        AFFICHER UNE PAGE PRECISE D UN PDF DEJA OUVERT AUTREMENT QUE PAR VBA      *
'date:17/08/2018                                                                   *
'auteur;patricktoulon chamalin2@hotmail.fr                                         *
'version 1.2                                                                       *
'***********************************************************************************
Option Explicit
Declare Function GetDesktopWindow Lib "user32" () As Long
Declare Function GetNextWindow Lib "user32" Alias "GetWindow" (ByVal hwnd As Long, ByVal wFlag As Long) As Long
Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal hwnd As Long, ByVal lpString As String, ByVal cch As Long) As Long
Declare Function ShowWindow Lib "user32" (ByVal hwnd As Long, ByVal nCmdShow As Long) As Long
'exemple fichier = "G:\vba excel\image avec WIA\silkyroad.developpez.com WIA  LIBRARY- .pdf"
Sub testx()
    Dim Nomfichier$, Intpage&, x&, i&
    Nomfichier = "silkyroad.developpez.com WIA  LIBRARY- .pdf"    'le fichier en exemple que j'ai ouvert a partir de son emplacement par l'explorateur
    Intpage = 10
    x = cherche_le_PDF(Nomfichier)
    If x <> 0 Then
        ShowWindow x, 3
        With CreateObject("wscript.shell")
            For i = 1 To 100: .SendKeys "{LEFT}": Next    'on ramene a la page 1 avec les touches fleche left
            For i = 1 To Intpage - 1: .SendKeys "{RIGHT}": Next    'on va a la page voulue avec la touche fleche droite
        End With
    Else
        MsgBox "cette fenetre n'a pas été trouvée"
    End If
End Sub
'
'
Function cherche_le_PDF(ByVal Nomfichier As String) As Long
    Dim stTmp$, lgTmp&, lgRet&, Handle&, HandlePDF&    'variables necessaires
    stTmp = Space$(120): lgTmp = 119   'on prevoit un buffer de 120 carateres pour les captions de fenetres visitées et  prévoit le len aussi
    Handle = GetDesktopWindow()    ' on choppe le handle du bureau c'est le 1er handle
    Handle = GetNextWindow(Handle, 5)    ' on choppe la premiere fenetre enfant du bureau avec l'argument "5"  pour l'api getnextwindow
    Do While Handle <> 0    ' on va boucler jusqu'a que handle donne "0"(plus de fenetre)
        Handle = GetNextWindow(Handle, 2)    'on recupere la fenetre enfant suivante du bureau dans le meme etage de la hierachie des fenetre (la soeur de la 1ere  quoi) et cela avec l'argument "2"!!!!!
        GetWindowText Handle, stTmp, lgTmp    ' on recupere le texte de la caption  de la fenetre en cours
        If stTmp Like "*" & Nomfichier & "*" Then HandlePDF = Handle: Exit Do    'et donc si le titre est trouvé on sort de la boucle avec le handlePDF renseigné
    Loop
    cherche_le_PDF = HandlePDF 'la fonction renvoie le handle de la fenetre ou "0"
End Function

voila vous savez tout il y en a une autre avec simplement findwindow mais je sais que selon les versions de Windows voir celle du pdfreader installé ca ne fonctionnera pas car la caption ne correspond pas forcement au nom exact du fichier avec findwindow

;)

edit:
je la met quand meme pour demontrer le probleme avec l'utilisation simple de finfwindow

Code:

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
'***********************************************************************************
'        AFFICHER UNE PAGE PRECISE D UN PDF DEJA OUVERT AUTREMENT QUE PAR VBA      *
'date:17/08/2018                                                                   *
'auteur;patricktoulon chamalin2@hotmail.fr                                         *
'version 1.3                                                                       *
'***********************************************************************************
Option Explicit
Declare Function ShowWindow Lib "user32" (ByVal hwnd As Long, ByVal nCmdShow As Long) As Long
Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
'exemple fichier = "G:\vba excel\image avec WIA\silkyroad.developpez.com WIA  LIBRARY- .pdf"
Sub testx2()
    Dim Nomfichier$, Intpage&, x&, i&
    Nomfichier = "silkyroad.developpez.com WIA  LIBRARY- .pdf"    'le fichier en exemple que j'ai ouvert a partir de son emplacement par l'explorateur
    Intpage = 10
    x = cherche_le_PDF(Nomfichier)
    If x <> 0 Then
        ShowWindow x, 3
        With CreateObject("wscript.shell")
            For i = 1 To 100: .SendKeys "{LEFT}": Next    'on ramene a la page 1 avec les touches fleche left
            For i = 1 To Intpage - 1: .SendKeys "{RIGHT}": Next    'on va a la page voulue avec la touche fleche droite
        End With
    Else
        MsgBox "cette fenetre n'a pas été trouvée"
    End If
End Sub
'
'
Function cherche_le_PDF(ByRef Nomfichier As String) As Long
    Dim HandlePDF
 ' je suis obligé d'ajouter le reste (""""""" - Adobe Reader"""""") ce qui n'est pas forcement pareil pour tout les versions d'adobe reader voir avec windows 10 c'est encore diferent 
  HandlePDF = FindWindow(vbNullString, Nomfichier & " - Adobe Reader")'
    cherche_le_PDF = HandlePDF 'la fonction renvoie le handle de la fenetre ou "0"
End Function