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

**Shooter422** · 12/08/2018, 16h48

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 :

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
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.

**Bob78280** · 16/08/2018, 16h27

Essaie ce code pour voir s'il te convient :

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
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

**Shooter422** · 16/08/2018, 17h22

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.

**sogedic** · 16/08/2018, 17h57

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